Released DG*5.3*796 SEQ #701 Extracted from mail message **KIDS**:DG*5.3*796^ **INSTALL NAME** DG*5.3*796 "BLD",7845,0) DG*5.3*796^REGISTRATION^0^3081110^y "BLD",7845,1,0) ^^1^1^3081106^ "BLD",7845,1,1,0) PTF PSEUDO DISCHARGE FIX, MISSING ROUTINE FIX, MAILMAN MESSAGE FIX FOR PDX "BLD",7845,4,0) ^9.64PA^^ "BLD",7845,6.3) 6 "BLD",7845,"INID") ^n "BLD",7845,"INIT") EN^DG53P796 "BLD",7845,"KRN",0) ^9.67PA^779.2^20 "BLD",7845,"KRN",.4,0) .4 "BLD",7845,"KRN",.401,0) .401 "BLD",7845,"KRN",.402,0) .402 "BLD",7845,"KRN",.403,0) .403 "BLD",7845,"KRN",.5,0) .5 "BLD",7845,"KRN",.84,0) .84 "BLD",7845,"KRN",3.6,0) 3.6 "BLD",7845,"KRN",3.8,0) 3.8 "BLD",7845,"KRN",9.2,0) 9.2 "BLD",7845,"KRN",9.8,0) 9.8 "BLD",7845,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",7845,"KRN",9.8,"NM",1,0) DGQPT^^0^B71263703 "BLD",7845,"KRN",9.8,"NM",2,0) DGWPT^^0^B9892752 "BLD",7845,"KRN",9.8,"NM",3,0) DGSEC^^0^B42431719 "BLD",7845,"KRN",9.8,"NM","B","DGQPT",1) "BLD",7845,"KRN",9.8,"NM","B","DGSEC",3) "BLD",7845,"KRN",9.8,"NM","B","DGWPT",2) "BLD",7845,"KRN",19,0) 19 "BLD",7845,"KRN",19.1,0) 19.1 "BLD",7845,"KRN",101,0) 101 "BLD",7845,"KRN",409.61,0) 409.61 "BLD",7845,"KRN",771,0) 771 "BLD",7845,"KRN",779.2,0) 779.2 "BLD",7845,"KRN",870,0) 870 "BLD",7845,"KRN",8989.51,0) 8989.51 "BLD",7845,"KRN",8989.52,0) 8989.52 "BLD",7845,"KRN",8994,0) 8994 "BLD",7845,"KRN","B",.4,.4) "BLD",7845,"KRN","B",.401,.401) "BLD",7845,"KRN","B",.402,.402) "BLD",7845,"KRN","B",.403,.403) "BLD",7845,"KRN","B",.5,.5) "BLD",7845,"KRN","B",.84,.84) "BLD",7845,"KRN","B",3.6,3.6) "BLD",7845,"KRN","B",3.8,3.8) "BLD",7845,"KRN","B",9.2,9.2) "BLD",7845,"KRN","B",9.8,9.8) "BLD",7845,"KRN","B",19,19) "BLD",7845,"KRN","B",19.1,19.1) "BLD",7845,"KRN","B",101,101) "BLD",7845,"KRN","B",409.61,409.61) "BLD",7845,"KRN","B",771,771) "BLD",7845,"KRN","B",779.2,779.2) "BLD",7845,"KRN","B",870,870) "BLD",7845,"KRN","B",8989.51,8989.51) "BLD",7845,"KRN","B",8989.52,8989.52) "BLD",7845,"KRN","B",8994,8994) "BLD",7845,"QUES",0) ^9.62^^ "BLD",7845,"REQB",0) ^9.611^2^2 "BLD",7845,"REQB",1,0) DG*5.3*447^1 "BLD",7845,"REQB",2,0) DG*5.3*769^1 "BLD",7845,"REQB","B","DG*5.3*447",1) "BLD",7845,"REQB","B","DG*5.3*769",2) "INIT") EN^DG53P796 "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 796^3081110 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3081110 "PKG",5,22,1,"PAH",1,1,1,0) PTF PSEUDO DISCHARGE FIX, MISSING ROUTINE FIX, MAILMAN MESSAGE FIX FOR PDX "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 4 "RTN","DG53P796") 0^^B12926435^n/a "RTN","DG53P796",1,0) DG53P796 ;ALB/RC - POST-INSTALL DG*5.3*796 ; 11/7/08 2:53pm "RTN","DG53P796",2,0) ;;5.3;Registration;**796**;Aug 13, 1993;Build 6 "RTN","DG53P796",3,0) Q "RTN","DG53P796",4,0) EN ;Entry Point "RTN","DG53P796",5,0) D INIT ;Initialize Variables "RTN","DG53P796",6,0) D REPORT ;Run Report "RTN","DG53P796",7,0) D CLEANUP ;Run Cleanup "RTN","DG53P796",8,0) Q "RTN","DG53P796",9,0) INIT ;Setup XTMP variable "RTN","DG53P796",10,0) K ^XTMP("DG53P796-"_$J) "RTN","DG53P796",11,0) S ^XTMP("DG53P796-"_$J,0)=$$FMADD^XLFDT(""_DT_"",30)_U_DT_U_"Data for cleanup for DG*5.3*796" ;Array used to store records that need to be cleaned up. "RTN","DG53P796",12,0) Q "RTN","DG53P796",13,0) REPORT ;Report of data to be cleaned up. "RTN","DG53P796",14,0) N RECNUM,DDATE,FDATE,PTDFN "RTN","DG53P796",15,0) N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM "RTN","DG53P796",16,0) I '$D(^XTMP("DG53P796-"_$J,0)) D INIT ;If called directly "RTN","DG53P796",17,0) S XMY(DUZ)="" ;Send message to installer "RTN","DG53P796",18,0) S XMSUB="List of records changed by DG*5.3*796" "RTN","DG53P796",19,0) S XMTEXT="MSGTXT(" "RTN","DG53P796",20,0) ;W "DFN",?15,"PTF NUMBER",?30,"DISCHARGE MOVEMENT DATE",! "RTN","DG53P796",21,0) ;F I=1:1:53 W "-" "RTN","DG53P796",22,0) ;W ! "RTN","DG53P796",23,0) S LINENUM=1 "RTN","DG53P796",24,0) S MSGTXT(LINENUM)="The records listed below were cleaned up by DG*5.3*796",LINENUM=LINENUM+1 "RTN","DG53P796",25,0) S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1 "RTN","DG53P796",26,0) S MSGTXT(LINENUM)="DFN PTF NUMBER DISCHARGE MVT DATE (501 MVT)",LINENUM=LINENUM+1 "RTN","DG53P796",27,0) S MSGTXT(LINENUM)="----------------------------------------------------------",LINENUM=LINENUM+1 "RTN","DG53P796",28,0) S RECNUM=0 ;start after the file header "RTN","DG53P796",29,0) F S RECNUM=$O(^DGPT(RECNUM)) Q:RECNUM'>0 D "RTN","DG53P796",30,0) .S DDATE=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),70) ;Discharge Date "RTN","DG53P796",31,0) .S FDATE=$$GET1^DIQ(45.02,"1,"_RECNUM,10) ;501 Discharge Date "RTN","DG53P796",32,0) .I DDATE'=FDATE,DDATE="" D "RTN","DG53P796",33,0) ..S ^XTMP("DG53P796-"_$J,RECNUM)=FDATE ;Store Bad Records "RTN","DG53P796",34,0) ..S PTDFN=$$GET1^DIQ(45,$$IENS^DILF(RECNUM),.01,"I") "RTN","DG53P796",35,0) ..;W PTDFN,?15,RECNUM,?30,FDATE,! "RTN","DG53P796",36,0) ..S MSGTXT(LINENUM)=$E(PTDFN_" ",1,15)_$E(RECNUM_" ",1,15)_FDATE "RTN","DG53P796",37,0) ..S LINENUM=LINENUM+1 "RTN","DG53P796",38,0) D ^XMD "RTN","DG53P796",39,0) Q "RTN","DG53P796",40,0) CLEANUP ;Perform clean up of records marked above. "RTN","DG53P796",41,0) N RECNUM,DGFDA,I,TXTLINE,ERRFND "RTN","DG53P796",42,0) N DIFROM,XMSUB,XMTEXT,XMY,MSGTXT,LINENUM "RTN","DG53P796",43,0) S XMSUB="Errors encountered during post-install of DG*5.3*796" "RTN","DG53P796",44,0) S XMY(DUZ)="" "RTN","DG53P796",45,0) S XMTEXT="MSGTXT(" "RTN","DG53P796",46,0) S LINENUM=1 "RTN","DG53P796",47,0) S MSGTXT(LINENUM)="The following errors were encountered while running the post-install routine in DG*5.3*796" "RTN","DG53P796",48,0) S MSGTXT(LINENUM)="",LINENUM=LINENUM+1,MSGTXT(LINENUM)="",LINENUM=LINENUM+1 "RTN","DG53P796",49,0) I '$D(^XTMP("DG53P796-"_$J,0)) D REPORT ;If called directly "RTN","DG53P796",50,0) S RECNUM=0,DGFDA="",DGMSG="" ;Start at the first record. "RTN","DG53P796",51,0) F S RECNUM=$O(^XTMP("DG53P796-"_$J,RECNUM)) Q:'RECNUM D "RTN","DG53P796",52,0) .S DGFDA(45.02,"1,"_$$IENS^DILF(RECNUM),10)="@" D FILE^DIE("","DGFDA") "RTN","DG53P796",53,0) .I $D(DIERR) D ;if we encounter an error, record it. "RTN","DG53P796",54,0) ..S ERRFND=1 ;we encountered an error "RTN","DG53P796",55,0) ..S MSGTXT(LINENUM)="The following errors were encountered with PTF record "_RECNUM_".",LINENUM=LINENUM+1 "RTN","DG53P796",56,0) ..F I=1:1:DIERR D "RTN","DG53P796",57,0) ...S MSGTXT(LINENUM)="Error Number: "_^TMP("DIERR",$J,I),LINENUM=LINENUM+1 "RTN","DG53P796",58,0) ...S TXTLINE="" "RTN","DG53P796",59,0) ...F S TXTLINE=$O(^TMP("DIERR",$J,I,"TEXT",TXTLINE)) Q:'TXTLINE D "RTN","DG53P796",60,0) ....S MSGTXT(LINENUM)=^TMP("DIERR",$J,I,"TEXT",TXTLINE),LINENUM=LINENUM+1 "RTN","DG53P796",61,0) .K DGFDA ;Cleanup data "RTN","DG53P796",62,0) I $G(ERRFND) D ^XMD ;only send if an error occurred. "RTN","DG53P796",63,0) Q "RTN","DGQPT") 0^1^B71263703^B72843346 "RTN","DGQPT",1,0) DGQPT ; SLC/MKB - Patient Selection ;8/8/97 13:07 "RTN","DGQPT",2,0) ;;5.3;Registration;**447,796**;Aug 13, 1993;Build 6 "RTN","DGQPT",3,0) ; "RTN","DGQPT",4,0) ; SLC/PKS - 3/2000: Modified to deal with "Combinations." "RTN","DGQPT",5,0) ; "RTN","DGQPT",6,0) EN ; -- main entry point for DG PATIENT SELECTION "RTN","DGQPT",7,0) I $G(DGVP),'($D(DGPNM)&$D(DGSSN)) K DGVP ; reset "RTN","DGQPT",8,0) D EN^VALM("DG PATIENT SELECTION") "RTN","DGQPT",9,0) Q "RTN","DGQPT",10,0) ; "RTN","DGQPT",11,0) HDR ; -- header code "RTN","DGQPT",12,0) N X I '$G(DGVP) S X="** No patient selected **" "RTN","DGQPT",13,0) E S X=$G(DGPNM)_" "_$G(DGSSN) "RTN","DGQPT",14,0) S VALMHDR(1)="Current patient: "_X "RTN","DGQPT",15,0) Q "RTN","DGQPT",16,0) ; "RTN","DGQPT",17,0) INIT ; -- init variables and list array "RTN","DGQPT",18,0) ; Modifications for multiple "Combination" lists by PKS. "RTN","DGQPT",19,0) ; "RTN","DGQPT",20,0) ; PARAM herein might end up as: DGLP DEFAULT CLINIC WEDNESDAY "RTN","DGQPT",21,0) ; (Param Name and current DOW) "RTN","DGQPT",22,0) ; DGY might end up passed as: 5^5^C;1;T-360;T+60;A "RTN","DGQPT",23,0) ; (#lines^#pts^source;serviceSection;startDate;stopDate;sort) "RTN","DGQPT",24,0) ; "RTN","DGQPT",25,0) N DGY,DGX,PARAM,DGYZB,DGYZE "RTN","DGQPT",26,0) ; "RTN","DGQPT",27,0) ;added by CLA 12/12/96 - gets SERVICE/SECTION of user: "RTN","DGQPT",28,0) N DGSRV S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U) "RTN","DGQPT",29,0) ; "RTN","DGQPT",30,0) S DGY=$$GET^XPAR("USR^SRV.`"_$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"I") ; Gets default list source for this user. "RTN","DGQPT",31,0) I $L(DGY) D S DGY=DGY_";"_DGX "RTN","DGQPT",32,0) . ; PKS: Set "PARAM" var to parameter name in param def file: "RTN","DGQPT",33,0) . S PARAM="DGLP DEFAULT "_$S(DGY="T":"TEAM",DGY="S":"SPECIALTY",DGY="P":"PROVIDER",DGY="W":"WARD",DGY="C":"CLINIC",DGY="M":"COMBINATION",1:"") "RTN","DGQPT",34,0) . S:DGY="C" PARAM=PARAM_" "_$$UP^XLFSTR($$DOW^XLFDT(DT)) ; For clinics, add current DOW. "RTN","DGQPT",35,0) . S DGX=$$GET^XPAR("USR^SRV.`"_$G(DGSRV),PARAM,1,"I") ; Source param. "RTN","DGQPT",36,0) . ; Next lines modified by PKS for "Combinations" and dates: "RTN","DGQPT",37,0) . I (DGY="C")!(DGY="M") D "RTN","DGQPT",38,0) . . S DGYZB=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"I")) ; Gets clinic start date. "RTN","DGQPT",39,0) . . I DGYZB="T+0" S DGYZB=$$FMTE^XLFDT(DT,DGYZB) "RTN","DGQPT",40,0) . . S DGX=DGX_";"_DGYZB "RTN","DGQPT",41,0) . . S DGYZE=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"I")) ; Add ";" & stop date. "RTN","DGQPT",42,0) . . I DGYZE="T+0" S DGYZE=$$FMTE^XLFDT(DT,DGYZE) "RTN","DGQPT",43,0) . . S DGX=DGX_";"_DGYZE "RTN","DGQPT",44,0) S $P(DGY,";",5)=$$GET^XPAR("USR^SRV.`"_$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT LIST ORDER",1,"I") ; Add default sort order. "RTN","DGQPT",45,0) ; "RTN","DGQPT",46,0) ; Call tag that builds the actual Patient Selection List: "RTN","DGQPT",47,0) D BUILD(DGY) "RTN","DGQPT",48,0) Q "RTN","DGQPT",49,0) ; "RTN","DGQPT",50,0) DEFAULT() ; -- Returns default action "RTN","DGQPT",51,0) I '$P($G(^TMP("DG",$J,"PATIENTS",0)),U,2) Q "Change View" "RTN","DGQPT",52,0) I XQORM("B")="Quit" Q "Close" "RTN","DGQPT",53,0) Q "Next Screen" "RTN","DGQPT",54,0) ; "RTN","DGQPT",55,0) MSG() ; -- Lmgr msg bar "RTN","DGQPT",56,0) Q "Enter the number of the patient chart to be opened" "RTN","DGQPT",57,0) ; "RTN","DGQPT",58,0) HELP ; -- help code "RTN","DGQPT",59,0) N X D FULL^VALM1 S VALMBCK="R" "RTN","DGQPT",60,0) W !!,"Enter the display number of the patient whose chart you wish to open" "RTN","DGQPT",61,0) W !,"or enter a patient name, SSN, or initial/last 4 combination. To" "RTN","DGQPT",62,0) W !,"change the list of patients displayed on this screen, enter CV. To" "RTN","DGQPT",63,0) W !,"have the new list automatically displayed when selecting a new patient," "RTN","DGQPT",64,0) W !,"enter SV. Enter FD to search by patient name or identifier." "RTN","DGQPT",65,0) W !!,"Press to continue ..." R X:DTIME "RTN","DGQPT",66,0) Q "RTN","DGQPT",67,0) ; "RTN","DGQPT",68,0) EXIT ; -- exit code "RTN","DGQPT",69,0) K ^TMP("DG",$J,"PATIENTS"),XQORM("ALT") "RTN","DGQPT",70,0) Q "RTN","DGQPT",71,0) ; "RTN","DGQPT",72,0) BUILD(LIST) ; -- build list in ^TMP("DG",$J,"PATIENTS") "RTN","DGQPT",73,0) N DGI,DGX,DGY,LCNT,NUM,DFN,NAME,TYPE,PTR,BEG,END,SORT,DOB,RBED,%DT,X,Y,TITLE,PTID,SENS "RTN","DGQPT",74,0) S TYPE=$E(LIST),PTR=+$P(LIST,";",2),SORT=$P(LIST,";",5) "RTN","DGQPT",75,0) ; Next 5 lines added by PKS: "RTN","DGQPT",76,0) I ((SORT="S")&(TYPE'="M")) S SORT="A" ; Reset invalid sorts. "RTN","DGQPT",77,0) I TYPE="M" D ; Deal with combinations. "RTN","DGQPT",78,0) .I ((SORT="P")!(SORT="A")!(SORT="S")) Q ; P,A,S are acceptable. "RTN","DGQPT",79,0) .S SORT="A" ; Default. "RTN","DGQPT",80,0) S $P(LIST,";",5)=SORT ; Reset in case of change. "RTN","DGQPT",81,0) S BEG=$P(LIST,";",3) I $L(BEG) S X=BEG,%DT="X" D ^%DT S BEG=Y "RTN","DGQPT",82,0) S END=$P(LIST,";",4) I $L(END) S X=END,%DT="X" D ^%DT S END=Y "RTN","DGQPT",83,0) I TYPE="T" D TEAMPTS^DGQPTQ1(.DGY,PTR) S TITLE="Team "_$P($G(^OR(100.21,+PTR,0)),U) "RTN","DGQPT",84,0) I TYPE="P" D PROVPTS^DGQPTQ2(.DGY,PTR) S TITLE="Provider "_$P($G(^VA(200,+PTR,0)),U) "RTN","DGQPT",85,0) I TYPE="S" D SPECPTS^DGQPTQ2(.DGY,PTR) S TITLE="Specialty "_$P($G(^DIC(45.7,+PTR,0)),U) "RTN","DGQPT",86,0) I TYPE="W" D WARDPTS^DGQPTQ2(.DGY,PTR) S TITLE="Ward "_$P($G(^DIC(42,+PTR,0)),U) "RTN","DGQPT",87,0) I TYPE="C" D CLINPTS^DGQPTQ2(.DGY,PTR,BEG,END) S TITLE="Clinic "_$P($G(^SC(+PTR,0)),U) "RTN","DGQPT",88,0) ; Next line added by PKS for "Combinations:" "RTN","DGQPT",89,0) I TYPE="M" N MSG D COMBPTS^DGQPTQ6(1,PTR,BEG,END) S TITLE="Combination List" ; Sets MSG,LCNT,NUM, and writes ^TMP("DG",$J,"PATIENTS"). "RTN","DGQPT",90,0) ; Next section added by PKS for "Combinations:" "RTN","DGQPT",91,0) I TYPE="M" D G BQ ; Check MSG var, then go to BQ tag. "RTN","DGQPT",92,0) .I MSG'="" D ; Did call to COMBPTS assign an error message? "RTN","DGQPT",93,0) ..S LCNT=1,NUM=0 ; Set defaults. "RTN","DGQPT",94,0) ..S ^TMP("DG",$J,"PATIENTS",1,0)=" "_MSG ; Write error msg. "RTN","DGQPT",95,0) D CLEAN^VALM10 S (LCNT,NUM)=0 ; All but "M" types reset, go on to B1. "RTN","DGQPT",96,0) ; "RTN","DGQPT",97,0) B1 S DGI=0 F S DGI=$O(DGY(DGI)) Q:DGI'>0 I DGY(DGI) D ; sort "RTN","DGQPT",98,0) . S DFN=+DGY(DGI) "RTN","DGQPT",99,0) . ;sort logic added by CLA 7/23/97: "RTN","DGQPT",100,0) . S DGX="" "RTN","DGQPT",101,0) . I SORT="P",(TYPE="C") S DGX=$P($G(DGY(DGI)),U,4) D "RTN","DGQPT",102,0) .. S $P(DGX,".",2)=$E($P(DGX,".",2)_"000",1,4) "RTN","DGQPT",103,0) ..S DGX=DGX_U_$P(DGY(DGI),U,2) "RTN","DGQPT",104,0) . I SORT="R",(TYPE'="C") S DGX=$P($G(^DPT(+DGY(DGI),.101)),U)_U_$P(DGY(DGI),U,2) "RTN","DGQPT",105,0) . I SORT="T" S DGX="" ; Need to add terminal digit sorting. "RTN","DGQPT",106,0) . ; If no sort specified, default to alphabetic (plus app't if clinic type): "RTN","DGQPT",107,0) . I DGX="" S DGX=$P(DGY(DGI),U,2)_U_$P($G(DGY(DGI)),U,4) "RTN","DGQPT",108,0) . S ^TMP("DG",$J,"PATIENTS","B",DGX_DFN)=DGY(DGI) ; DFN ^ Name "RTN","DGQPT",109,0) I '$D(^TMP("DG",$J,"PATIENTS")) D G BQ "RTN","DGQPT",110,0) . N MSG "RTN","DGQPT",111,0) . S MSG="No patients found" "RTN","DGQPT",112,0) . S LCNT=1,NUM=0 "RTN","DGQPT",113,0) . I $D(DGY(1)) S MSG=$P(DGY(1),"^",2) ; error message from search "RTN","DGQPT",114,0) . S ^TMP("DG",$J,"PATIENTS",1,0)=" "_MSG "RTN","DGQPT",115,0) B2 S DGX="" F S DGX=$O(^TMP("DG",$J,"PATIENTS","B",DGX)) Q:DGX="" S DGY=^(DGX) D "RTN","DGQPT",116,0) . S DFN=+DGY,NAME=$P(DGY,U,2) "RTN","DGQPT",117,0) . S DOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) "RTN","DGQPT",118,0) . S:(TYPE'="C") RBED=$P($G(^DPT(DFN,.101)),U) "RTN","DGQPT",119,0) . I (TYPE="C") S RBED=$S(SORT="P":$$FMTE^XLFDT($P(DGX,U)),1:$$FMTE^XLFDT($P(^TMP("DG",$J,"PATIENTS","B",DGX),U,4))) "RTN","DGQPT",120,0) . ;Q:RBED="" removed by CLA 7/23/97 to prevent blank lines "RTN","DGQPT",121,0) . S LCNT=LCNT+1,NUM=NUM+1 "RTN","DGQPT",122,0) . S ^TMP("DG",$J,"PATIENTS","IDX",NUM)=DGY ; DFN ^ NAME "RTN","DGQPT",123,0) . ; Next lines modified/added by PKS on 1/24/2001: "RTN","DGQPT",124,0) . ; Check for "sensitive" patients: "RTN","DGQPT",125,0) . S PTID="" "RTN","DGQPT",126,0) . S PTID=$$ID(DFN) "RTN","DGQPT",127,0) . S SENS=$$SSN^DPTLK1(DFN) "RTN","DGQPT",128,0) . I SENS["*" S PTID="" "RTN","DGQPT",129,0) . S DOB=$$DOB^DPTLK1(DFN) "RTN","DGQPT",130,0) . S ^TMP("DG",$J,"PATIENTS",LCNT,0)=$$LJ^XLFSTR(NUM,5)_$$LJ^XLFSTR(NAME,31)_$$LJ^XLFSTR(PTID,10)_$$LJ^XLFSTR(DOB,15)_$G(RBED) "RTN","DGQPT",131,0) . D CNTRL^VALM10(LCNT,1,5,IOINHI,IOINORM) "RTN","DGQPT",132,0) BQ S ^TMP("DG",$J,"PATIENTS",0)=LCNT_U_NUM_U_$G(LIST) ; #lines^#pts^context "RTN","DGQPT",133,0) S ^TMP("DG",$J,"PATIENTS","#")=$O(^ORD(101,"B","ORQPT SELECT PATIENT",0))_"^1:"_NUM "RTN","DGQPT",134,0) S RBED=$S(TYPE="C":"Appointment Date",TYPE="M":"Source Other",1:"Room-Bed") "RTN","DGQPT",135,0) D CHGCAP^VALM("ROOM-BED",RBED) K VALMHDR "RTN","DGQPT",136,0) S VALMCNT=LCNT,VALMBG=1,VALMBCK="R" S:$L($G(TITLE)) VALM("TITLE")=TITLE "RTN","DGQPT",137,0) Q "RTN","DGQPT",138,0) ; "RTN","DGQPT",139,0) ID(DFN) ; -- Returns short ID for patient ID "RTN","DGQPT",140,0) N ID S ID=$P($G(^DPT(DFN,.36)),U,4) ; short ID "RTN","DGQPT",141,0) I '$L(ID) S ID=$E($P($G(^DPT(DFN,0)),U,9),6,9) ; last 4 of SSN "RTN","DGQPT",142,0) Q "("_$E(NAME)_ID_")" "RTN","DGQPT",143,0) ; "RTN","DGQPT",144,0) APPT(DFN,CLINIC,FROM,TO) ; -- Return [next?] clinic appointment "RTN","DGQPT",145,0) N VASD,VAERR K ^UTILITY("VASD",$J) "RTN","DGQPT",146,0) S VASD("F")=FROM,VASD("T")=TO,VASD("C",CLINIC)="" "RTN","DGQPT",147,0) D SDA^VADPT S NEXT=+$O(^UTILITY("VASD",$J,0)),NEXT=$P($G(^(NEXT,"I")),U) "RTN","DGQPT",148,0) K ^UTILITY("VASD",$J) "RTN","DGQPT",149,0) Q NEXT "RTN","DGQPT",150,0) ; "RTN","DGQPT",151,0) ALT ; -- XQORM("ALT") code to search File 2 for patient X "RTN","DGQPT",152,0) N DIC,DFN,Y,DGX S DGX=X D FULL^VALM1 "RTN","DGQPT",153,0) S DIC=2,DIC(0)="EQM",X=$S($D(XQORMRCL):" ",1:DGX) "RTN","DGQPT",154,0) D ^DIC I Y'>0 S VALMBCK="R" Q ;S XQORMERR=1 Q "RTN","DGQPT",155,0) S DGX=+$G(^DPT(+Y,.35)) I DGX,'$$OK(DGX) S VALMBCK="R" Q "RTN","DGQPT",156,0) S DFN=+Y G:DFN'=+$G(DGVP) SLCT1 ; set patient variables "RTN","DGQPT",157,0) Q "RTN","DGQPT",158,0) ; "RTN","DGQPT",159,0) FIND ; -- find patient in ^DPT "RTN","DGQPT",160,0) N X,Y,DIC,DGX,DFN "RTN","DGQPT",161,0) S DIC=2,DIC(0)="AEQM" D FULL^VALM1 "RTN","DGQPT",162,0) D ^DIC I Y'>0 S VALMBCK="R" Q "RTN","DGQPT",163,0) S DGX=+$G(^DPT(+Y,.35)) I DGX,'$$OK(DGX) S VALMBCK="R" Q "RTN","DGQPT",164,0) S DFN=+Y G:DFN'=+$G(DGVP) SLCT1 ; set patient variables "RTN","DGQPT",165,0) Q "RTN","DGQPT",166,0) ; "RTN","DGQPT",167,0) SELECT ; -- select patient from list "RTN","DGQPT",168,0) N NMBR,X,Y,Z,DIC,DFN,DGX S NMBR=+$P(XQORNOD(0),"=",2) "RTN","DGQPT",169,0) S Y=$G(^TMP("DG",$J,"PATIENTS","IDX",NMBR)),DFN=+Y "RTN","DGQPT",170,0) I 'DFN W $C(7),!!,NMBR_" is not a valid selection.",! S VALMBCK="" H 1 Q "RTN","DGQPT",171,0) ;W " "_$P(Y,U,2) S ^DISV(DUZ,"^DPT(")=DFN "RTN","DGQPT",172,0) D FULL^VALM1 S DIC=2,DIC(0)="EQM",X="`"_DFN D ^DIC I Y<0 S VALMBCK="R" Q "RTN","DGQPT",173,0) S DGX=+$G(^DPT(+Y,.35)) I DGX,'$$OK(DGX) S VALMBCK="R" Q "RTN","DGQPT",174,0) SLCT1 ; -- may enter here with DFN from FIND "RTN","DGQPT",175,0) N VADM,VAEL,VAIN,VA,VAERR,LOC,ORCNV "RTN","DGQPT",176,0) D OERR^VADPT,ELIG^VADPT "RTN","DGQPT",177,0) S LOC=+$G(^DIC(42,+VAIN(4),44))_";SC(" I 'LOC,'$D(XQAID) D "RTN","DGQPT",178,0) . I $G(NMBR) N X S X=$$CONTEXT^DGQPT1 I $E(X)="C" S LOC=$P(X,";",2)_";SC(" Q:LOC ; use clinic if selected from list, else ask "RTN","DGQPT",179,0) . S LOC="" "RTN","DGQPT",180,0) S DGL=LOC,DGL(0)=$P($G(^SC(+DGL,0)),U),DGL(1)=VAIN(5) "RTN","DGQPT",181,0) S DGVP=DFN_";DPT(",DGPNM=VADM(1),DGSSN=$P(VADM(2),U,2) "RTN","DGQPT",182,0) S DGDOB=$P(VADM(3),U,2),DGAGE=VADM(4),DGSEX=$P(VADM(5),U) "RTN","DGQPT",183,0) S DGTS=+VAIN(3),DGWARD=VAIN(4),DGATTEND=+VAIN(11),DGSC=$G(VAEL(3)) "RTN","DGQPT",184,0) I $P($G(^DGSL(38.1,+DGVP,0)),"^",2),($G(^DPT(+DGVP,.1))]""!$D(^XUSEC("DG SENSITIVITY",DUZ))) D "RTN","DGQPT",185,0) . ; if senstive patient and (patient inpatient or user holds key) "RTN","DGQPT",186,0) . ; prevents sensitive patient warning from scrolling off screen "RTN","DGQPT",187,0) . N X "RTN","DGQPT",188,0) . W !!,"Press to continue ..." "RTN","DGQPT",189,0) . R X:DTIME "RTN","DGQPT",190,0) SLCT2 ; -- convert patient's orders, if not already done "RTN","DGQPT",191,0) ;ORDERS NO LONGER BEING CONVERTED "RTN","DGQPT",192,0) ;S DGCNV=$$OTF^OR3CONV(+DGVP) Q:'DGCNV I DGCNV>0 W !,"DONE" H 1 Q "RTN","DGQPT",193,0) ;I DGCNV<0 W $C(7),!!,$P(DGCNV,U,2) H 2 S VALMBCK="R" Q "RTN","DGQPT",194,0) Q "RTN","DGQPT",195,0) ; "RTN","DGQPT",196,0) OK(DATE) ; -- Patient is deceased; ok to continue? "RTN","DGQPT",197,0) N X,Y,DIR S DIR(0)="YA",DIR("B")="NO" "RTN","DGQPT",198,0) S DIR("A")="Do you wish to continue? " "RTN","DGQPT",199,0) W $C(7),!!,"This patient died "_$$FMTE^XLFDT(DATE)_"!" "RTN","DGQPT",200,0) D ^DIR "RTN","DGQPT",201,0) Q +Y "RTN","DGSEC") 0^3^B42431719^B42705118 "RTN","DGSEC",1,0) DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm "RTN","DGSEC",2,0) ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796**;Aug 13, 1993;Build 6 "RTN","DGSEC",3,0) ; "RTN","DGSEC",4,0) ;Entry point from DPTLK "RTN","DGSEC",5,0) I +$G(Y)=+$G(^DISV(DUZ,"^DPT(")),$G(DPTBTDT) K DPTBTDT Q "RTN","DGSEC",6,0) N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1 "RTN","DGSEC",7,0) ;Y=Patient file DFN "RTN","DGSEC",8,0) S DGY=Y "RTN","DGSEC",9,0) ;OWNREC^DGSEC4 parameters: "RTN","DGSEC",10,0) ; DGREC = output array passed by reference "RTN","DGSEC",11,0) ; DGY = Patient file DFN "RTN","DGSEC",12,0) ; DUZ = New Person file IEN "RTN","DGSEC",13,0) ; 1=generate error msg "RTN","DGSEC",14,0) ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry "RTN","DGSEC",15,0) ; DGPTSSN - set to patient's SSN when adding new Patient file entry "RTN","DGSEC",16,0) ; X=Patient's SSN from DPTLK2 "RTN","DGSEC",17,0) I $G(DGNEWPT)=1 S DGPTSSN=X "RTN","DGSEC",18,0) D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN)) "RTN","DGSEC",19,0) S Y=DGY "RTN","DGSEC",20,0) I DGREC(1)=1!(DGREC(1)=2) D G Q "RTN","DGSEC",21,0) .S Y=-1 "RTN","DGSEC",22,0) .D DISP(.DGREC) "RTN","DGSEC",23,0) .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME "RTN","DGSEC",24,0) ;SENS^DGSEC4 parameters: "RTN","DGSEC",25,0) ; DGSENS = output array passed by reference "RTN","DGSEC",26,0) ; Y = Patient fileDFN "RTN","DGSEC",27,0) ; DUZ = New Person file IEN "RTN","DGSEC",28,0) ; DDS - Screenman variable "RTN","DGSEC",29,0) ; DGSENFLG - If defined, patient record sensitivity not checked "RTN","DGSEC",30,0) D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG) "RTN","DGSEC",31,0) ;DUZ must be defined to access a sensitive record "RTN","DGSEC",32,0) I DGSENS(1)=-1 D G Q "RTN","DGSEC",33,0) .S Y=-1 "RTN","DGSEC",34,0) .D DISP(.DGSENS) "RTN","DGSEC",35,0) I DGSENS(1)=0 G Q "RTN","DGSEC",36,0) ;Get option name for DG Security Log file and bulletin "RTN","DGSEC",37,0) D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",38,0) I DGSENS(1)=1 D "RTN","DGSEC",39,0) .I DIC(0)["E" D "RTN","DGSEC",40,0) ..W $C(7) "RTN","DGSEC",41,0) ..D DISP(.DGSENS) "RTN","DGSEC",42,0) .I Y>0 D "RTN","DGSEC",43,0) ..;Parameters: DFN,DUZ,,Option name^Menu text "RTN","DGSEC",44,0) ..D SETLOG1(+Y,DUZ,,DGOPT) "RTN","DGSEC",45,0) I DGSENS(1)=2 D "RTN","DGSEC",46,0) .I DIC(0)["E" D "RTN","DGSEC",47,0) ..W $C(7) "RTN","DGSEC",48,0) ..D DISP(.DGSENS) "RTN","DGSEC",49,0) ..D NOTCE1 "RTN","DGSEC",50,0) .I Y>0 D "RTN","DGSEC",51,0) ..D SETLOG1(+Y,DUZ,,DGOPT) "RTN","DGSEC",52,0) ..;Parameters: DFN,DUZ,Option name^Menu text,message array "RTN","DGSEC",53,0) ..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG) "RTN","DGSEC",54,0) ..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG) "RTN","DGSEC",55,0) D Q "RTN","DGSEC",56,0) Q "RTN","DGSEC",57,0) ; "RTN","DGSEC",58,0) REC ;DPTLK2 entry point when adding new Patient file record "RTN","DGSEC",59,0) ;Input: X=Patient's SSN "RTN","DGSEC",60,0) ;Output: DGREC=1 (adding own record or SSN not defined) or 0 "RTN","DGSEC",61,0) ; "RTN","DGSEC",62,0) ;Parameters: DGREC=output array "RTN","DGSEC",63,0) ; DUZ "RTN","DGSEC",64,0) ; 1 - generate error msg "RTN","DGSEC",65,0) ; DGNEWPT = 1 (adding new Patient (#2) file record "RTN","DGSEC",66,0) ; DGPTSSN = X (Patient's SSN) "RTN","DGSEC",67,0) N DGPTSSN "RTN","DGSEC",68,0) S DGPTSSN=X "RTN","DGSEC",69,0) D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN)) "RTN","DGSEC",70,0) I DGREC(1)=1!(DGREC(1)=2) D "RTN","DGSEC",71,0) .D DISP(.DGREC) "RTN","DGSEC",72,0) .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME "RTN","DGSEC",73,0) S DGREC=+DGREC(1) "RTN","DGSEC",74,0) I DGREC=2 S DGREC=1 "RTN","DGSEC",75,0) Q "RTN","DGSEC",76,0) SETLOG ;Entry point for DBIA #2242 "RTN","DGSEC",77,0) ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text "RTN","DGSEC",78,0) D SETLOG1(Y,DUZ,DG1,DGOPT) "RTN","DGSEC",79,0) D Q "RTN","DGSEC",80,0) Q "RTN","DGSEC",81,0) BULTIN ;Entry point for DBIA #2242 "RTN","DGSEC",82,0) ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text "RTN","DGSEC",83,0) D BULTIN1(Y,DUZ,DGOPT) "RTN","DGSEC",84,0) Q "RTN","DGSEC",85,0) SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1) "RTN","DGSEC",86,0) ;Input: "RTN","DGSEC",87,0) ; DFN - Patient (#2) file DFN (Required) "RTN","DGSEC",88,0) ; DGDUZ - New Person (#200) file IEN "RTN","DGSEC",89,0) ; DG1 - Inpatient or Outpatient (Optional) "RTN","DGSEC",90,0) ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional) "RTN","DGSEC",91,0) ; "RTN","DGSEC",92,0) N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT "RTN","DGSEC",93,0) ;DG/582 "RTN","DGSEC",94,0) I $G(VALM("TITLE"))="Dependents Module" Q "RTN","DGSEC",95,0) ;Lock global "RTN","DGSEC",96,0) LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK "RTN","DGSEC",97,0) ;Add new entry for patient if not found "RTN","DGSEC",98,0) I '$D(^DGSL(38.1,+DFN,0)) D "RTN","DGSEC",99,0) .S ^DGSL(38.1,+DFN,0)=+DFN "RTN","DGSEC",100,0) .S ^DGSL(38.1,"B",+DFN,+DFN)="" "RTN","DGSEC",101,0) .S $P(^DGSL(38.1,0),U,3)=+DFN "RTN","DGSEC",102,0) .S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1 "RTN","DGSEC",103,0) .;Determine if entry is automatically sensitive "RTN","DGSEC",104,0) .N ELIG,FLAG,X "RTN","DGSEC",105,0) .S FLAG=0 "RTN","DGSEC",106,0) .S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"") "RTN","DGSEC",107,0) .I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1 "RTN","DGSEC",108,0) .I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG "RTN","DGSEC",109,0) ..S X=$G(^DIC(8,ELIG,0)) "RTN","DGSEC",110,0) ..I $P(X,"^",12) S FLAG=1 "RTN","DGSEC",111,0) .S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG "RTN","DGSEC",112,0) .;Date/time sensitivity was set "RTN","DGSEC",113,0) .S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT() "RTN","DGSEC",114,0) ;determine if an inpatient "RTN","DGSEC",115,0) D H^DGUTL "RTN","DGSEC",116,0) S DGT=DGTIME "RTN","DGSEC",117,0) I $G(DG1)="" D ^DGPMSTAT "RTN","DGSEC",118,0) ;get option name "RTN","DGSEC",119,0) I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",120,0) SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR "RTN","DGSEC",121,0) S:'$D(^DGSL(38.1,+DFN,"D",0)) ^(0)="^38.11DA^^" S ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$P(DGOPT,U,2)_U_$S(DG1:"y",1:"n"),$P(^(0),U,3,4)=DGDTE_U_($P(^DGSL(38.1,+DFN,"D",0),U,4)+1) "RTN","DGSEC",122,0) S ^DGSL(38.1,"AD",DGDTE,+DFN)="" "RTN","DGSEC",123,0) S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)="" "RTN","DGSEC",124,0) L -^DGSL(38.1,+DFN) "RTN","DGSEC",125,0) Q "RTN","DGSEC",126,0) Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT "RTN","DGSEC",127,0) N DGTEST S DGTEST=^%ZOSF("TEST") "RTN","DGSEC",128,0) I DIC(0)["E",Y>0 D "RTN","DGSEC",129,0) .S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display "RTN","DGSEC",130,0) ..N DGPFSAVY S DGPFSAVY=Y "RTN","DGSEC",131,0) ..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY "RTN","DGSEC",132,0) .S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI "RTN","DGSEC",133,0) .S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD "RTN","DGSEC",134,0) .S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR "RTN","DGSEC",135,0) Q "RTN","DGSEC",136,0) ; "RTN","DGSEC",137,0) BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin "RTN","DGSEC",138,0) ; "RTN","DGSEC",139,0) ;Input: DFN = Patient file IEN "RTN","DGSEC",140,0) ; DGDUZ = New Person (#200) file IEN "RTN","DGSEC",141,0) ; DGOPT = Option (#19) file Name (#.01)^Menu text "RTN","DGSEC",142,0) ; DGMSG = Message array (Optional) "RTN","DGSEC",143,0) ; "RTN","DGSEC",144,0) N DGEMPLEE,XMSUB,XQOPT "RTN","DGSEC",145,0) ;DG/582 "RTN","DGSEC",146,0) I $G(VALM("TITLE"))="Dependents Module" Q "RTN","DGSEC",147,0) K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10 "RTN","DGSEC",148,0) Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED" "RTN","DGSEC",149,0) S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB "RTN","DGSEC",150,0) S DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR") Q:'$L(DGB) "RTN","DGSEC",151,0) ;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB) "RTN","DGSEC",152,0) I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2)) "RTN","DGSEC",153,0) N XMB,XMY,XMY0,XMZ "RTN","DGSEC",154,0) S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U) "RTN","DGSEC",155,0) S DGEMPLEE=$$EMPL^DGSEC4(+DFN) "RTN","DGSEC",156,0) I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)" "RTN","DGSEC",157,0) S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)="" "RTN","DGSEC",158,0) N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y "RTN","DGSEC",159,0) D SEND(.XMB,.XMY) "RTN","DGSEC",160,0) S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer." "RTN","DGSEC",161,0) Q "RTN","DGSEC",162,0) ; "RTN","DGSEC",163,0) SEND(XMB,XMY) ;Queue mail bulletin "RTN","DGSEC",164,0) ;Input: XMB,XMY=Mailman bulletin parameters "RTN","DGSEC",165,0) ; "RTN","DGSEC",166,0) D ^XMB "RTN","DGSEC",167,0) Q "RTN","DGSEC",168,0) ; "RTN","DGSEC",169,0) DISP(ARRAY) ;Display message text to screen "RTN","DGSEC",170,0) ;Input: Array containg message text "RTN","DGSEC",171,0) ; "RTN","DGSEC",172,0) I '$D(ARRAY) Q "RTN","DGSEC",173,0) I DIC(0)'["E" Q "RTN","DGSEC",174,0) I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM") "RTN","DGSEC",175,0) N DGI,DGWHERE "RTN","DGSEC",176,0) I '$D(DDS) W !! "RTN","DGSEC",177,0) F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D "RTN","DGSEC",178,0) .S DGWHERE=(80-$L(ARRAY(DGI)))\2 "RTN","DGSEC",179,0) .W ?DGWHERE,ARRAY(DGI),! "RTN","DGSEC",180,0) Q "RTN","DGSEC",181,0) ; "RTN","DGSEC",182,0) NOTCE1 W:'$D(DDS) !! W "Do you want to continue processing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue processing, or 'NO' to quit processing this record." W:$D(DDS) ! G NOTCE1 "RTN","DGSEC",183,0) .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY "RTN","DGSEC",184,0) Q "RTN","DGSEC",185,0) ; "RTN","DGSEC",186,0) LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array "RTN","DGSEC",187,0) ;PDX plans to use this - remember to NEW DIC before ^XMD call "RTN","DGSEC",188,0) ; Input - None "RTN","DGSEC",189,0) ; Output - XMY("G.mailgroupname")="" if field #509 is defined "RTN","DGSEC",190,0) ; where mailgroupname is text value of mail group "RTN","DGSEC",191,0) ; Returns: 0 - Ok "RTN","DGSEC",192,0) ; -1^errortext - if can't find mail group "RTN","DGSEC",193,0) ; "RTN","DGSEC",194,0) N DGB,DGERR,DGM "RTN","DGSEC",195,0) S DGERR=0 "RTN","DGSEC",196,0) S DGB=+$P($G(^DG(43,1,"NOT")),"^",10) "RTN","DGSEC",197,0) S DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR") "RTN","DGSEC",198,0) I '$D(DGM) S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX "RTN","DGSEC",199,0) S XMY("G."_DGM)="" ; pass mailgroup "RTN","DGSEC",200,0) QTLOADX Q DGERR "RTN","DGWPT") 0^2^B9892752^B10008432 "RTN","DGWPT",1,0) DGWPT ; SLC/KCM/REV - Patient Lookup Functions ;3/20/02 "RTN","DGWPT",2,0) ;;5.3;Registration;**447,796**;Aug 13, 1993;Build 6 "RTN","DGWPT",3,0) ; "RTN","DGWPT",4,0) SELCHK(REC,DFN) ; Check for sensitive pt "RTN","DGWPT",5,0) ; SENSITIVE "RTN","DGWPT",6,0) S REC=$$EN1^DGQPT2(DFN) "RTN","DGWPT",7,0) Q "RTN","DGWPT",8,0) DIEDON(VAL,DFN) ; Check for a date of death "RTN","DGWPT",9,0) S VAL=+$G(^DPT(DFN,.35)) "RTN","DGWPT",10,0) Q "RTN","DGWPT",11,0) BYWARD(LST,WARD) ; Return a list of patients in a ward "RTN","DGWPT",12,0) N ILST,DFN "RTN","DGWPT",13,0) I +$G(WARD)<1 S LST(1)="^No ward identified" Q "RTN","DGWPT",14,0) S (ILST,DFN)=0 "RTN","DGWPT",15,0) S WARD=$P(^DIC(42,WARD,0),"^") ;DBIA #36 "RTN","DGWPT",16,0) F S DFN=$O(^DPT("CN",WARD,DFN)) Q:DFN'>0 D "RTN","DGWPT",17,0) . S ILST=ILST+1,LST(ILST)=+DFN_U_$P(^DPT(+DFN,0),U)_U_$G(^DPT(+DFN,.101)) "RTN","DGWPT",18,0) I ILST<1 S LST(1)="^No patients found." "RTN","DGWPT",19,0) Q "RTN","DGWPT",20,0) TOP(LST) ; Return top for all patients list (last selected for now) "RTN","DGWPT",21,0) N IEN "RTN","DGWPT",22,0) S IEN=$G(^DISV(DUZ,"^DPT(")) "RTN","DGWPT",23,0) I IEN S LST(1)=IEN_U_$P($G(^DPT(IEN,0)),U) "RTN","DGWPT",24,0) Q "RTN","DGWPT",25,0) CLINRNG(LST) ; return date ranges for clinic appointments "RTN","DGWPT",26,0) S LST(1)="T;T^Today" "RTN","DGWPT",27,0) S LST(2)="T+1;T+1^Tomorrow" "RTN","DGWPT",28,0) S LST(3)="T-1;T-1^Yesterday" "RTN","DGWPT",29,0) S LST(4)="T-7;T^Past Week" "RTN","DGWPT",30,0) S LST(5)="T-31;T^Past Month" "RTN","DGWPT",31,0) S LST(6)="S^Specify Date Range..." "RTN","DGWPT",32,0) Q "RTN","DGWPT",33,0) ; "RTN","DGWPT",34,0) N %,%H,X,SUNDAY,START "RTN","DGWPT",35,0) S LST(1)=DT_";"_DT_"^Today",X=$$HTFM^XLFDT($H+1,1) "RTN","DGWPT",36,0) S LST(2)=X_";"_X_"^Tomorrow" "RTN","DGWPT",37,0) S X=+$H F Q:X#7=3 S X=X-1 ; $H#7=3 is Sunday "RTN","DGWPT",38,0) S LST(3)=$$HTFM^XLFDT(X)_";"_$$HTFM^XLFDT(X+6)_"^This Week" "RTN","DGWPT",39,0) S LST(4)=$$HTFM^XLFDT(X+7)_";"_$$HTFM^XLFDT(X+13)_"^Next Week" "RTN","DGWPT",40,0) S LST(5)=$E(DT,1,5)_"01;"_$E(DT,1,5)_"31^This Month" "RTN","DGWPT",41,0) S X=$E(DT,4,5)+1 S:X=13 X=1 S X=$E(DT,1,3)_$TR($J(X,2)," ",0) "RTN","DGWPT",42,0) S LST(6)=X_"01;"_X_"31^Next Month" "RTN","DGWPT",43,0) S LST(7)="^Specify Dates" "RTN","DGWPT",44,0) Q "RTN","DGWPT",45,0) DFLTSRC(VAL) ; return default patient list source (T, W, C, P, S) "RTN","DGWPT",46,0) N SRV S SRV=+$G(^VA(200,DUZ,5)) "RTN","DGWPT",47,0) S VAL=$$GET^XPAR("ALL^SRV.`"_SRV,"ORLP DEFAULT LIST SOURCE") "RTN","DGWPT",48,0) Q "RTN","DGWPT",49,0) SAVDFLT(OK,X) ; save new default patient list settings (X=type^ien^sdt;edt) "RTN","DGWPT",50,0) G SAVDFLT^DGWPT1 "RTN","DGWPT",51,0) ; "RTN","DGWPT",52,0) SELECT(REC,DFN) ; Selects patient & returns key information "RTN","DGWPT",53,0) ; 1 2 3 4 5 6 7 8 9 10 11 12 "RTN","DGWPT",54,0) ; NAME^SEX^DOB^SSN^LOCIEN^LOCNM^RMBD^CWAD^SENSITIVE^ADMITTED^CONV^SC^ "RTN","DGWPT",55,0) ; 13 14 15 16 "RTN","DGWPT",56,0) ; SC%^ICN^AGE^TS "RTN","DGWPT",57,0) N X "RTN","DGWPT",58,0) K ^TMP("DGWPCE",$J) ; delete PCE 'cache' when switching patients "RTN","DGWPT",59,0) S X=^DPT(DFN,0),REC=$P(X,U,1,3)_U_$P(X,U,9)_U_U_$G(^(.1))_U_$G(^(.101)) "RTN","DGWPT",60,0) S X=$P(REC,U,6) I $L(X) S $P(REC,U,5)=+$G(^DIC(42,+$O(^DIC(42,"B",X,0)),44)) "RTN","DGWPT",61,0) S $P(REC,U,8)=$$CWAD^DGQPT2(DFN)_U_$$EN1^DGQPT2(DFN) "RTN","DGWPT",62,0) ; I $P(REC,U,9) D EN2^DGQPT2(DFN) ;update DG security log ; DG249 "RTN","DGWPT",63,0) S X=$G(^DPT(DFN,.105)) I X S $P(REC,U,10)=$P($G(^DGPM(X,0)),U) "RTN","DGWPT",64,0) S:'$D(IOST) IOST="P-OTHER" "RTN","DGWPT",65,0) S $P(REC,U,11)=0 "RTN","DGWPT",66,0) D ELIG^VADPT S $P(REC,U,12)=$G(VAEL(3)) ;two pieces: SC^SC% "RTN","DGWPT",67,0) I $L($T(GETICN^MPIF001)) S X=+$$GETICN^MPIF001(DFN) S:X>0 $P(REC,U,14)=X "RTN","DGWPT",68,0) S $P(REC,U,15)=$$AGE(DFN,$P(REC,U,3)) "RTN","DGWPT",69,0) S $P(REC,U,16)=+$G(^DPT(DFN,.103)) ; treating specialty "RTN","DGWPT",70,0) K VAEL,VAERR ;VADPT call to kill? "RTN","DGWPT",71,0) S ^DISV(DUZ,"^DPT(")=DFN "RTN","DGWPT",72,0) Q "RTN","DGWPT",73,0) ; "RTN","DGWPT",74,0) AGE(DFN,BEG) ; returns age based on date of birth and date of death (or DT) "RTN","DGWPT",75,0) N END,X "RTN","DGWPT",76,0) S END=+$G(^DPT(DFN,.35)),END=$S(END:END,1:DT) "RTN","DGWPT",77,0) S X=$E(END,1,3)-$E(BEG,1,3)-($E(END,4,7)<$E(BEG,4,7)) "RTN","DGWPT",78,0) Q X "VER") 8.0^22.0 "BLD",7845,6) ^701 **END** **END**