Released DG*5.3*960 SEQ #844 Extracted from mail message **KIDS**:DG*5.3*960^ **INSTALL NAME** DG*5.3*960 "BLD",10700,0) DG*5.3*960^REGISTRATION^0^3180709^y "BLD",10700,1,0) ^^2^2^3180705^^ "BLD",10700,1,1,0) This Build contains components for the report enhancements to PRF by the "BLD",10700,1,2,0) SHRPE project. "BLD",10700,4,0) ^9.64PA^^ "BLD",10700,6) 9^ "BLD",10700,6.3) 22 "BLD",10700,"ABPKG") n "BLD",10700,"KRN",0) ^9.67PA^779.2^20 "BLD",10700,"KRN",.4,0) .4 "BLD",10700,"KRN",.401,0) .401 "BLD",10700,"KRN",.402,0) .402 "BLD",10700,"KRN",.403,0) .403 "BLD",10700,"KRN",.5,0) .5 "BLD",10700,"KRN",.84,0) .84 "BLD",10700,"KRN",3.6,0) 3.6 "BLD",10700,"KRN",3.8,0) 3.8 "BLD",10700,"KRN",9.2,0) 9.2 "BLD",10700,"KRN",9.8,0) 9.8 "BLD",10700,"KRN",9.8,"NM",0) ^9.68A^9^9 "BLD",10700,"KRN",9.8,"NM",1,0) DGPFRAL^^0^B36782112 "BLD",10700,"KRN",9.8,"NM",2,0) DGPFRAL1^^0^B101428491 "BLD",10700,"KRN",9.8,"NM",3,0) DGPFUT63^^0^B562903 "BLD",10700,"KRN",9.8,"NM",4,0) DGPFRFA^^0^B5793844 "BLD",10700,"KRN",9.8,"NM",5,0) DGPFRFA1^^0^B123710577 "BLD",10700,"KRN",9.8,"NM",6,0) DGPFAAH2^^0^B33241692 "BLD",10700,"KRN",9.8,"NM",7,0) DGPFLMT^^0^B4570198 "BLD",10700,"KRN",9.8,"NM",8,0) DGPFLMT1^^0^B68794802 "BLD",10700,"KRN",9.8,"NM",9,0) DGPFUT7^^0^B34083826 "BLD",10700,"KRN",9.8,"NM","B","DGPFAAH2",6) "BLD",10700,"KRN",9.8,"NM","B","DGPFLMT",7) "BLD",10700,"KRN",9.8,"NM","B","DGPFLMT1",8) "BLD",10700,"KRN",9.8,"NM","B","DGPFRAL",1) "BLD",10700,"KRN",9.8,"NM","B","DGPFRAL1",2) "BLD",10700,"KRN",9.8,"NM","B","DGPFRFA",4) "BLD",10700,"KRN",9.8,"NM","B","DGPFRFA1",5) "BLD",10700,"KRN",9.8,"NM","B","DGPFUT63",3) "BLD",10700,"KRN",9.8,"NM","B","DGPFUT7",9) "BLD",10700,"KRN",19,0) 19 "BLD",10700,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",10700,"KRN",19,"NM",1,0) DGPF FLAG ASSIGNMENT REPORT^^0 "BLD",10700,"KRN",19,"NM",2,0) DGPF ACTION NOT LINKED REPORT^^0 "BLD",10700,"KRN",19,"NM","B","DGPF ACTION NOT LINKED REPORT",2) "BLD",10700,"KRN",19,"NM","B","DGPF FLAG ASSIGNMENT REPORT",1) "BLD",10700,"KRN",19.1,0) 19.1 "BLD",10700,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",10700,"KRN",101,0) 101 "BLD",10700,"KRN",409.61,0) 409.61 "BLD",10700,"KRN",409.61,"NM",0) ^9.68A^1^1 "BLD",10700,"KRN",409.61,"NM",1,0) DGPF TRANSMISSION ERRORS^^0 "BLD",10700,"KRN",409.61,"NM","B","DGPF TRANSMISSION ERRORS",1) "BLD",10700,"KRN",771,0) 771 "BLD",10700,"KRN",779.2,0) 779.2 "BLD",10700,"KRN",870,0) 870 "BLD",10700,"KRN",8989.51,0) 8989.51 "BLD",10700,"KRN",8989.52,0) 8989.52 "BLD",10700,"KRN",8994,0) 8994 "BLD",10700,"KRN","B",.4,.4) "BLD",10700,"KRN","B",.401,.401) "BLD",10700,"KRN","B",.402,.402) "BLD",10700,"KRN","B",.403,.403) "BLD",10700,"KRN","B",.5,.5) "BLD",10700,"KRN","B",.84,.84) "BLD",10700,"KRN","B",3.6,3.6) "BLD",10700,"KRN","B",3.8,3.8) "BLD",10700,"KRN","B",9.2,9.2) "BLD",10700,"KRN","B",9.8,9.8) "BLD",10700,"KRN","B",19,19) "BLD",10700,"KRN","B",19.1,19.1) "BLD",10700,"KRN","B",101,101) "BLD",10700,"KRN","B",409.61,409.61) "BLD",10700,"KRN","B",771,771) "BLD",10700,"KRN","B",779.2,779.2) "BLD",10700,"KRN","B",870,870) "BLD",10700,"KRN","B",8989.51,8989.51) "BLD",10700,"KRN","B",8989.52,8989.52) "BLD",10700,"KRN","B",8994,8994) "BLD",10700,"QDEF") ^^^^NO^^^^NO^^NO "BLD",10700,"QUES",0) ^9.62^^ "BLD",10700,"REQB",0) ^9.611^1^1 "BLD",10700,"REQB",1,0) DG*5.3*892^2 "BLD",10700,"REQB","B","DG*5.3*892",1) "KRN",19,2919315,-1) 0^1 "KRN",19,2919315,0) DGPF FLAG ASSIGNMENT REPORT^Flag Assignment Report^^R^^^^^^^^REGISTRATION^^^ "KRN",19,2919315,1,0) ^19.06^2^2^3180709^^^^ "KRN",19,2919315,1,1,0) This option enables a user to display or print all of the patient "KRN",19,2919315,1,2,0) assignments for Category I and/or Category II Patient Record Flags. "KRN",19,2919315,15) "KRN",19,2919315,25) EN^DGPFRFA "KRN",19,2919315,99) 59168,40517 "KRN",19,2919315,99.1) 61802,34437 "KRN",19,2919315,200.9) ^y "KRN",19,2919315,"U") FLAG ASSIGNMENT REPORT "KRN",19,2920277,-1) 0^2 "KRN",19,2920277,0) DGPF ACTION NOT LINKED REPORT^Assignment Action Not Linked Report^^R^^^^^^^^REGISTRATION^ "KRN",19,2920277,1,0) ^19.06^2^2^3180629^^ "KRN",19,2920277,1,1,0) This option will be used to display or print all of the PRF Assignment "KRN",19,2920277,1,2,0) History actions that are not linked to a progress note. "KRN",19,2920277,25) EN^DGPFRAL "KRN",19,2920277,200.9) ^y "KRN",19,2920277,"U") ASSIGNMENT ACTION NOT LINKED R "KRN",409.61,641,-1) 0^1 "KRN",409.61,641,0) DGPF TRANSMISSION ERRORS^1^^80^5^17^1^1^Transmission Error^DGPF TRANSMISSION ERRORS MENU^TRANSMISSION ERRORS^1^999^1 "KRN",409.61,641,1) ^VALM HIDDEN ACTIONS "KRN",409.61,641,"ARRAY") ^TMP("DGPFLMT",$J) "KRN",409.61,641,"COL",0) ^409.621^5^4 "KRN",409.61,641,"COL",2,0) PATIENT NAME^6^30^Patient Name^^0 "KRN",409.61,641,"COL",3,0) SSN^38^4^SSN^^0 "KRN",409.61,641,"COL",4,0) ERROR RECEIVED D/T^44^8^Error On^^0 "KRN",409.61,641,"COL",5,0) SITE TRANSMITTED TO^54^27^Transmitted To "KRN",409.61,641,"COL","AIDENT",0,2) "KRN",409.61,641,"COL","AIDENT",0,3) "KRN",409.61,641,"COL","AIDENT",0,4) "KRN",409.61,641,"COL","B","ERROR RECEIVED D/T",4) "KRN",409.61,641,"COL","B","PATIENT NAME",2) "KRN",409.61,641,"COL","B","SITE TRANSMITTED TO",5) "KRN",409.61,641,"COL","B","SSN",3) "KRN",409.61,641,"FNL") D EXIT^DGPFLMT "KRN",409.61,641,"HDR") D HDR^DGPFLMT "KRN",409.61,641,"HLP") D HELP^DGPFLMT "KRN",409.61,641,"INIT") D INIT^DGPFLMT "MBREQ") 0 "ORD",17,409.61) 409.61;17;1;;;;LME1^XPDIA1;;;LMDEL^XPDIA1 "ORD",17,409.61,0) LIST TEMPLATE "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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^2930930 "PKG",5,22,1,"PAH",1,0) 960^3180709^520824656 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3180709 "PKG",5,22,1,"PAH",1,1,1,0) This Build contains components for the report enhancements to PRF by the "PKG",5,22,1,"PAH",1,1,2,0) SHRPE project. "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") 9 "RTN","DGPFAAH2") 0^6^B33241692^n/a "RTN","DGPFAAH2",1,0) DGPFAAH2 ;SHRPE/SGM - PRF ASSIGNMENT HISTORY API'S ; 5/1/2018 17:00 "RTN","DGPFAAH2",2,0) ;;5.3;Registration;**960**;Aug 13, 1993;Build 22 "RTN","DGPFAAH2",3,0) ; Last Edited: SHRPE/sgm - Jul 5, 2018 11:07 "RTN","DGPFAAH2",4,0) ; "RTN","DGPFAAH2",5,0) ; This routine was introduced in patch 960 to provide additional "RTN","DGPFAAH2",6,0) ; History related APIs. Patch DG*5.3*951 will be released subsequent "RTN","DGPFAAH2",7,0) ; to this 960 patch. The 951 will provide a common API entry point "RTN","DGPFAAH2",8,0) ; in the DGPFAAH routine. "RTN","DGPFAAH2",9,0) ; "RTN","DGPFAAH2",10,0) ; This routine will ONLY be invoked via the DGPFAAH routine! "RTN","DGPFAAH2",11,0) ; "RTN","DGPFAAH2",12,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFAAH2",13,0) ;----- ---- ------------------------------------ "RTN","DGPFAAH2",14,0) ; 2052 Sup $$GET1^DID "RTN","DGPFAAH2",15,0) ;10103 Sup $$FMTE^XLFDT "RTN","DGPFAAH2",16,0) ; "RTN","DGPFAAH2",17,0) QUIT "RTN","DGPFAAH2",18,0) ;------------------------ API Entry Points ------------------------- "RTN","DGPFAAH2",19,0) ; "RTN","DGPFAAH2",20,0) ACTFILT(DGHIST,DGIEN,DGACT,DGFLDS,DGBY) ; "RTN","DGPFAAH2",21,0) ; For an assignment, return a list of History records with a specific "RTN","DGPFAAH2",22,0) ; action type "RTN","DGPFAAH2",23,0) D ACT Q:$Q +$G(@DGHIST) Q "RTN","DGPFAAH2",24,0) ; "RTN","DGPFAAH2",25,0) INACT(DGIEN) ; "RTN","DGPFAAH2",26,0) ; For an assignment, return the date of the last inactivation action "RTN","DGPFAAH2",27,0) Q $$LASTIN "RTN","DGPFAAH2",28,0) ; "RTN","DGPFAAH2",29,0) LAST(DGIEN) ; "RTN","DGPFAAH2",30,0) ; For an assignment, return the date of the last activation action "RTN","DGPFAAH2",31,0) Q $$LASTACT "RTN","DGPFAAH2",32,0) ; "RTN","DGPFAAH2",33,0) ;----------------- Private Main Processing Modules ----------------- "RTN","DGPFAAH2",34,0) ACT ; "RTN","DGPFAAH2",35,0) ; Find all History records associated with an assignment and return "RTN","DGPFAAH2",36,0) ; only those History records of a certain ACTION types "RTN","DGPFAAH2",37,0) ; This may be called as an Extrinsic Function or as a DO w/params "RTN","DGPFAAH2",38,0) ; Use APIs in DGPFAAH if you wish all history records and data "RTN","DGPFAAH2",39,0) ; Use APIs in DGPFAA if you wish all assignment record data "RTN","DGPFAAH2",40,0) ; "RTN","DGPFAAH2",41,0) ; INPUT PARAMETERS: "RTN","DGPFAAH2",42,0) ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH2",43,0) ; DGACT - required - ';'-delimited string of ACTION set of codes "RTN","DGPFAAH2",44,0) ; see ^DD(26.14,.03) "RTN","DGPFAAH2",45,0) ; DGFLDS - optional - return field values from 26.14 "RTN","DGPFAAH2",46,0) ; ';'-delimited string can be field numbers or text "RTN","DGPFAAH2",47,0) ; subscripts as returned in DGPFAAH and DGPFAA routines "RTN","DGPFAAH2",48,0) ; Default - ACTION ; DATE/TIME "RTN","DGPFAAH2",49,0) ; DGBY - optional - return sorting order, default to I "RTN","DGPFAAH2",50,0) ; A:sort by action (action_code,ien)=ien^action_code^date/time "RTN","DGPFAAH2",51,0) ; D:sort by date (date/time,ien) =ien^action_code^date/time "RTN","DGPFAAH2",52,0) ; I:sort by ien (1,ien) =ien^action_code^date/time "RTN","DGPFAAH2",53,0) ; "RTN","DGPFAAH2",54,0) ; RETURN PARAMETER: "RTN","DGPFAAH2",55,0) ; DGHIST - named reference to return values "RTN","DGPFAAH2",56,0) ; default to .DGHIST "RTN","DGPFAAH2",57,0) ; @DGHIST = total number of records returned or -1 "RTN","DGPFAAH2",58,0) ; @DGHIST@(sub1,sub2,sub3) = internal_FM_value ^ external_FM_value "RTN","DGPFAAH2",59,0) ; where sub1 = action_code_name if BY="A" "RTN","DGPFAAH2",60,0) ; sub1 = assignment date.time if BY="D" "RTN","DGPFAAH2",61,0) ; sub1 = 1 if BY="I" "RTN","DGPFAAH2",62,0) ; sub2 = history record ien "RTN","DGPFAAH2",63,0) ; sub3 = text name for history field (see F14 below) "RTN","DGPFAAH2",64,0) ; "RTN","DGPFAAH2",65,0) ; EXTRINSIC FUNCTION: "RTN","DGPFAAH2",66,0) ; Return the total number of history records found "RTN","DGPFAAH2",67,0) ; "RTN","DGPFAAH2",68,0) N CNT,DGHIEN,INPUT,TMP "RTN","DGPFAAH2",69,0) S CNT=0 "RTN","DGPFAAH2",70,0) S RET=$G(DGHIST) S:RET="" RET="DGHIST" "RTN","DGPFAAH2",71,0) S TMP=$NA(^TMP("DGPFAAH2",$J)) K @TMP "RTN","DGPFAAH2",72,0) ; validate input parameters "RTN","DGPFAAH2",73,0) ; INPUT("FLDS",field#) = text_subscript "RTN","DGPFAAH2",74,0) ; INPUT("FLDS",text_subscript) = field# "RTN","DGPFAAH2",75,0) ; INPUT("ACT",set_of_code#) = set of code name "RTN","DGPFAAH2",76,0) ; INPUT("BY") = A / D / I "RTN","DGPFAAH2",77,0) I '$$INPUT S CNT=-1 G ACTOUT "RTN","DGPFAAH2",78,0) ; get all History records for an assignment "RTN","DGPFAAH2",79,0) ; if entered in error action encountered, remove all history records "RTN","DGPFAAH2",80,0) ; prior to the EIE record "RTN","DGPFAAH2",81,0) I $$GETALLDT^DGPFAAH(DGIEN,.DGHIEN) D "RTN","DGPFAAH2",82,0) . ; dghien(assignment_dt)=hien "RTN","DGPFAAH2",83,0) . N DATE "RTN","DGPFAAH2",84,0) . ; sort history data by assignment date.time "RTN","DGPFAAH2",85,0) . S DATE=-1 F S DATE=$O(DGHIEN(DATE)) Q:'DATE D "RTN","DGPFAAH2",86,0) . . N DGPFAH,HIEN "RTN","DGPFAAH2",87,0) . . S HIEN=DGHIEN(DATE) "RTN","DGPFAAH2",88,0) . . ; Q:'$$GETHIST^DGPFAAH(HIEN,.DGPFAH,1) ;after patch 960 released "RTN","DGPFAAH2",89,0) . . Q:'$$GETHIST^DGPFAAH(HIEN,.DGPFAH) "RTN","DGPFAAH2",90,0) . . M @TMP@(DATE,HIEN)=DGPFAH "RTN","DGPFAAH2",91,0) . . Q "RTN","DGPFAAH2",92,0) . ; D EIE "RTN","DGPFAAH2",93,0) . Q "RTN","DGPFAAH2",94,0) ; "RTN","DGPFAAH2",95,0) I $D(@TMP) D "RTN","DGPFAAH2",96,0) . N I,X,Y,ACT,DATE,HIEN,SUB "RTN","DGPFAAH2",97,0) . ; filter records and set up return array "RTN","DGPFAAH2",98,0) . S DATE=-1 F S DATE=$O(@TMP@(DATE)) Q:'DATE D "RTN","DGPFAAH2",99,0) . . S HIEN=0 F S HIEN=$O(@TMP@(DATE,HIEN)) Q:'HIEN D "RTN","DGPFAAH2",100,0) . . . ; is history record one of the actions "RTN","DGPFAAH2",101,0) . . . S ACT=+$G(@TMP@(DATE,HIEN,"ACTION")) "RTN","DGPFAAH2",102,0) . . . I '$D(INPUT("ACT",ACT)) K @TMP@(DATE,HIEN) Q "RTN","DGPFAAH2",103,0) . . . S CNT=CNT+1 "RTN","DGPFAAH2",104,0) . . . S X=INPUT("BY") "RTN","DGPFAAH2",105,0) . . . S SUB=$S(X="A":INPUT("ACT",ACT),X="D":DATE,1:1) "RTN","DGPFAAH2",106,0) . . . ; set up return with field text names, not field# "RTN","DGPFAAH2",107,0) . . . S X=100 F S X=$O(INPUT("FLDS",X)) Q:X="" D "RTN","DGPFAAH2",108,0) . . . . S @RET@(SUB,HIEN,X)=@TMP@(DATE,HIEN,X) "RTN","DGPFAAH2",109,0) . . . . Q "RTN","DGPFAAH2",110,0) . . . Q "RTN","DGPFAAH2",111,0) . . Q "RTN","DGPFAAH2",112,0) . Q "RTN","DGPFAAH2",113,0) ; "RTN","DGPFAAH2",114,0) ACTOUT ; "RTN","DGPFAAH2",115,0) S @RET=CNT "RTN","DGPFAAH2",116,0) K @TMP "RTN","DGPFAAH2",117,0) Q:$Q CNT "RTN","DGPFAAH2",118,0) Q "RTN","DGPFAAH2",119,0) ; "RTN","DGPFAAH2",120,0) LASTACT ; "RTN","DGPFAAH2",121,0) ; For a PRF assignment return that date of the last activation action "RTN","DGPFAAH2",122,0) ; "RTN","DGPFAAH2",123,0) ; INPUT PARAMETER: "RTN","DGPFAAH2",124,0) ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH2",125,0) ; EXTRINSIC FUNCTION: return null or p1^p2^p3 "RTN","DGPFAAH2",126,0) ; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy "RTN","DGPFAAH2",127,0) ; "RTN","DGPFAAH2",128,0) N DATE,DGACT,DGBY,DGFLDS,DGHIST "RTN","DGPFAAH2",129,0) S DGACT="1;3;4;5" "RTN","DGPFAAH2",130,0) S DGFLDS=".01;.02;.03" "RTN","DGPFAAH2",131,0) S DGBY="D" "RTN","DGPFAAH2",132,0) S DATE="" I $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0 D "RTN","DGPFAAH2",133,0) . ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val "RTN","DGPFAAH2",134,0) . N X,Y,ACT,IEN "RTN","DGPFAAH2",135,0) . S Y="A" F S Y=$O(DGHIST(Y),-1) Q:Y<1 D Q:DATE "RTN","DGPFAAH2",136,0) . . S IEN="A" F S IEN=$O(DGHIST(Y,IEN),-1) Q:'IEN D Q:DATE "RTN","DGPFAAH2",137,0) . . . S ACT=+$G(DGHIST(Y,IEN,"ACTION")) "RTN","DGPFAAH2",138,0) . . . I ACT=1!(ACT=4) S DATE=Y "RTN","DGPFAAH2",139,0) . . . Q "RTN","DGPFAAH2",140,0) . . Q "RTN","DGPFAAH2",141,0) . Q "RTN","DGPFAAH2",142,0) S:DATE $P(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z") "RTN","DGPFAAH2",143,0) Q DATE "RTN","DGPFAAH2",144,0) ; "RTN","DGPFAAH2",145,0) LASTIN ; "RTN","DGPFAAH2",146,0) ;For a PRF assignment return that date of the last inactivation action "RTN","DGPFAAH2",147,0) ; "RTN","DGPFAAH2",148,0) ; INPUT PARAMETER: "RTN","DGPFAAH2",149,0) ; DGIEN - required - Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFAAH2",150,0) ; EXTRINSIC FUNCTION: return null or p1^p2^p3 "RTN","DGPFAAH2",151,0) ; p1 = internal FM date.time p2 = mm/dd/yy p3 = mm/dd/yyyy "RTN","DGPFAAH2",152,0) ; "RTN","DGPFAAH2",153,0) N DATE,DGACT,DGBY,DGFLDS,DGHIST "RTN","DGPFAAH2",154,0) S DGACT="3;5" "RTN","DGPFAAH2",155,0) S DGFLDS=".01;.02;.03" "RTN","DGPFAAH2",156,0) S DGBY="D" "RTN","DGPFAAH2",157,0) S DATE="" "RTN","DGPFAAH2",158,0) I $$ACTFILT(.DGHIST,DGIEN,DGACT,DGFLDS,DGBY)>0 D "RTN","DGPFAAH2",159,0) . ; dghist(assign_d/t,hist_ien,field_text) = int_val^ext_val "RTN","DGPFAAH2",160,0) . N X,Y,ACT,IEN "RTN","DGPFAAH2",161,0) . S Y="A" F S Y=$O(DGHIST(Y),-1) Q:Y<1 D Q:DATE "RTN","DGPFAAH2",162,0) . . S IEN="A" F S IEN=$O(DGHIST(Y,IEN),-1) Q:'IEN D Q:DATE "RTN","DGPFAAH2",163,0) . . . S ACT=+$G(DGHIST(Y,IEN,"ACTION")) "RTN","DGPFAAH2",164,0) . . . I ACT=3!(ACT=5) S DATE=Y "RTN","DGPFAAH2",165,0) . . . Q "RTN","DGPFAAH2",166,0) . . Q "RTN","DGPFAAH2",167,0) . Q "RTN","DGPFAAH2",168,0) S:DATE $P(DATE,U,2)=$$FMTE^XLFDT(DATE\1,"2Z")_U_$$FMTE^XLFDT(DATE\1,"5Z") "RTN","DGPFAAH2",169,0) Q DATE "RTN","DGPFAAH2",170,0) ; "RTN","DGPFAAH2",171,0) ;----------------------- PRIVATE SUBROUTINES ----------------------- "RTN","DGPFAAH2",172,0) ; "RTN","DGPFAAH2",173,0) F14 ; "RTN","DGPFAAH2",174,0) ;;.01^ASSIGN "RTN","DGPFAAH2",175,0) ;;.02^ASSIGNDT "RTN","DGPFAAH2",176,0) ;;.03^ACTION "RTN","DGPFAAH2",177,0) ;;.04^ENTERBY "RTN","DGPFAAH2",178,0) ;;.05^APPRVBY "RTN","DGPFAAH2",179,0) ;;.06^TIULINK "RTN","DGPFAAH2",180,0) ;;.09^ORIGFAC "RTN","DGPFAAH2",181,0) ;; "RTN","DGPFAAH2",182,0) N I,X,Y "RTN","DGPFAAH2",183,0) F I=1:1 S X=$P($T(F14+I),";",3) Q:X="" D "RTN","DGPFAAH2",184,0) . S Y=$P(X,U,2),DATA(+X)=Y,DATA(Y)=+X "RTN","DGPFAAH2",185,0) . Q "RTN","DGPFAAH2",186,0) Q "RTN","DGPFAAH2",187,0) ; "RTN","DGPFAAH2",188,0) INPUT() ; validate input parameters "RTN","DGPFAAH2",189,0) N I,X,Y,DATA,DGERR,DIERR,TMP,TX "RTN","DGPFAAH2",190,0) S DGIEN=+$G(DGIEN) I '$D(^DGPF(26.13,DGIEN,0)) Q 0 "RTN","DGPFAAH2",191,0) D F14 ; sets up DATA() "RTN","DGPFAAH2",192,0) ; validate DGFLDS "RTN","DGPFAAH2",193,0) ; INPUT("FLDS",file#,field#)=textname "RTN","DGPFAAH2",194,0) ; INPUT("FLDS",file#,textname)=field# "RTN","DGPFAAH2",195,0) S X=$G(DGFLDS) I $L(X) D "RTN","DGPFAAH2",196,0) . F I=1:1:$L(X,";") S Y=$P(X,";",I) D "RTN","DGPFAAH2",197,0) . . Q:Y="" Q:'$D(DATA(Y)) "RTN","DGPFAAH2",198,0) . . S TX=$S(Y=+Y:DATA(Y),1:Y) "RTN","DGPFAAH2",199,0) . . I Y'=+Y S Y=DATA(TX) "RTN","DGPFAAH2",200,0) . . S INPUT("FLDS",Y)=TX,INPUT("FLDS",TX)=Y "RTN","DGPFAAH2",201,0) . . Q "RTN","DGPFAAH2",202,0) . Q "RTN","DGPFAAH2",203,0) ; add in default fields if necessary "RTN","DGPFAAH2",204,0) S X="ASSIGNDT" I '$D(INPUT("FLDS",X)) D "RTN","DGPFAAH2",205,0) . S INPUT("FLDS",.02)=X,INPUT("FLDS",X)=.02 "RTN","DGPFAAH2",206,0) . Q "RTN","DGPFAAH2",207,0) S X="ACTION" I '$D(INPUT("FLDS",X)) D "RTN","DGPFAAH2",208,0) . S INPUT("FLDS",.03)=X,INPUT("FLDS",X)=.03 "RTN","DGPFAAH2",209,0) . Q "RTN","DGPFAAH2",210,0) ; validate DGACT "RTN","DGPFAAH2",211,0) S DGACT=$G(DGACT) I DGACT="" Q 0 "RTN","DGPFAAH2",212,0) S X=$$GET1^DID(26.14,.03,,"SET OF CODES",,"DGERR") "RTN","DGPFAAH2",213,0) F I=1:1:$L(X,";") S Y=$P(X,";",I) Q:Y="" S TMP(+Y)=$P(Y,":",2) "RTN","DGPFAAH2",214,0) F I=1:1:$L(DGACT,";") S X=$P(DGACT,";",I) D "RTN","DGPFAAH2",215,0) . I +X,$D(TMP(X)) S INPUT("ACT",X)=TMP(X) "RTN","DGPFAAH2",216,0) . Q "RTN","DGPFAAH2",217,0) I '$D(INPUT("ACT")) Q 0 "RTN","DGPFAAH2",218,0) ; validate DGBY "RTN","DGPFAAH2",219,0) S X=$G(DGBY),X=$S(X="":"I","ADI"[$E(X):$E(X),1:"I") "RTN","DGPFAAH2",220,0) S INPUT("BY")=X "RTN","DGPFAAH2",221,0) Q 1 "RTN","DGPFLMT") 0^7^B4570198^B2035581 "RTN","DGPFLMT",1,0) DGPFLMT ;ALB/RBS - PRF TRANSMISSION ERRORS LM SCREEN ; 4/27/05 12:00pm "RTN","DGPFLMT",2,0) ;;5.3;Registration;**650,960**;Aug 13, 1993;Build 22 "RTN","DGPFLMT",3,0) ; Last Edited: SHRPE/SGM - May 30, 2018 11:01 "RTN","DGPFLMT",4,0) ;- no direct entry "RTN","DGPFLMT",5,0) QUIT "RTN","DGPFLMT",6,0) ; "RTN","DGPFLMT",7,0) ; "RTN","DGPFLMT",8,0) EN ;Main entry point for DGPF TRANSMISSION ERRORS option. "RTN","DGPFLMT",9,0) ; "RTN","DGPFLMT",10,0) ; Input: None "RTN","DGPFLMT",11,0) ; Output: None "RTN","DGPFLMT",12,0) ; "RTN","DGPFLMT",13,0) ;invoke DGPF TRANSMISSION ERRORS list template "RTN","DGPFLMT",14,0) N DGSORT,DGSRTBY "RTN","DGPFLMT",15,0) S DGSRTBY="N" "RTN","DGPFLMT",16,0) Q:'$$PROMPT "RTN","DGPFLMT",17,0) ; "RTN","DGPFLMT",18,0) D EN^VALM("DGPF TRANSMISSION ERRORS") "RTN","DGPFLMT",19,0) Q "RTN","DGPFLMT",20,0) ; "RTN","DGPFLMT",21,0) ; "RTN","DGPFLMT",22,0) HDR ;Header Code "RTN","DGPFLMT",23,0) N X,Y "RTN","DGPFLMT",24,0) S Y=$S($G(DGSORT("BY"))="N":"Patient Name",1:"Date Error Received") "RTN","DGPFLMT",25,0) S X="List Sorted By: "_Y "RTN","DGPFLMT",26,0) S VALMHDR(2)="" "RTN","DGPFLMT",27,0) S VALMHDR(2)=$$SETSTR^VALM1(X,VALMHDR(2),1,$L(X)) "RTN","DGPFLMT",28,0) S Y=$G(DGSORT("FLAG")) S:Y="" Y="A" "RTN","DGPFLMT",29,0) S X="Active, Locally-Owned, Category I Flag" "RTN","DGPFLMT",30,0) S X=X_$S(Y="A":"s: ALL",1:": "_$P(Y,U,2)) "RTN","DGPFLMT",31,0) S VALMHDR(1)="" "RTN","DGPFLMT",32,0) S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),1,$L(X)) "RTN","DGPFLMT",33,0) Q "RTN","DGPFLMT",34,0) ; "RTN","DGPFLMT",35,0) ; "RTN","DGPFLMT",36,0) INIT ;Init variables and list array "RTN","DGPFLMT",37,0) D BLD "RTN","DGPFLMT",38,0) Q "RTN","DGPFLMT",39,0) ; "RTN","DGPFLMT",40,0) ; "RTN","DGPFLMT",41,0) BLD ;Build HL7 Transmission Log "RJ" Rejected Status message list "RTN","DGPFLMT",42,0) D CLEAN^VALM10 "RTN","DGPFLMT",43,0) K DGARY,VALMHDR "RTN","DGPFLMT",44,0) S:$G(DGSRTBY)="" DGSRTBY="N" S DGSORT("BY")=DGSRTBY "RTN","DGPFLMT",45,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLMT",46,0) ; "RTN","DGPFLMT",47,0) ;- init array that will contain list of items to display "RTN","DGPFLMT",48,0) S DGARY="DGPFLMT" "RTN","DGPFLMT",49,0) K ^TMP(DGARY,$J) "RTN","DGPFLMT",50,0) ; "RTN","DGPFLMT",51,0) ;build header area "RTN","DGPFLMT",52,0) D HDR "RTN","DGPFLMT",53,0) ; "RTN","DGPFLMT",54,0) ;init # of lines in list "RTN","DGPFLMT",55,0) S VALMCNT=0 "RTN","DGPFLMT",56,0) ; "RTN","DGPFLMT",57,0) ;- call to build list area for error messages "RTN","DGPFLMT",58,0) D EN^DGPFLMT1(DGARY,DGSORT("BY"),.VALMCNT) "RTN","DGPFLMT",59,0) Q "RTN","DGPFLMT",60,0) ; "RTN","DGPFLMT",61,0) ; "RTN","DGPFLMT",62,0) HELP ;Help Code "RTN","DGPFLMT",63,0) N X "RTN","DGPFLMT",64,0) S X="?" D DISP^XQORM1 W !! "RTN","DGPFLMT",65,0) Q "RTN","DGPFLMT",66,0) ; "RTN","DGPFLMT",67,0) ; "RTN","DGPFLMT",68,0) EXIT ;Exit Code "RTN","DGPFLMT",69,0) D CLEAN^VALM10 "RTN","DGPFLMT",70,0) D CLEAR^VALM1 "RTN","DGPFLMT",71,0) K ^TMP("DGPFSORT",$J) "RTN","DGPFLMT",72,0) K ^TMP(DGARY,$J) "RTN","DGPFLMT",73,0) K DGARY "RTN","DGPFLMT",74,0) Q "RTN","DGPFLMT",75,0) ; "RTN","DGPFLMT",76,0) ; "RTN","DGPFLMT",77,0) EXPND ;Expand Code "RTN","DGPFLMT",78,0) Q "RTN","DGPFLMT",79,0) ; "RTN","DGPFLMT",80,0) PROMPT() ; ----- prompts before LM invoked "RTN","DGPFLMT",81,0) ; Set local variables to be available throughout the LM actions "RTN","DGPFLMT",82,0) ; I '$$PROMPT then quit the Option "RTN","DGPFLMT",83,0) ; DGSORT("BY") = "N" "RTN","DGPFLMT",84,0) ; DGSORT("FLAG") = "A" or variable_pointer^flagname "RTN","DGPFLMT",85,0) ; DGSORT("STAT") = 1 - active assignments "RTN","DGPFLMT",86,0) ; DGSORT("OWN") = 1 - OWNER SITE is from local facility "RTN","DGPFLMT",87,0) ; "RTN","DGPFLMT",88,0) N X,Y "RTN","DGPFLMT",89,0) ;-- sort list (default="N"=Patient Name, also "E"=Date Error Received) "RTN","DGPFLMT",90,0) S DGSORT("BY")=DGSRTBY "RTN","DGPFLMT",91,0) ; "RTN","DGPFLMT",92,0) ;-- prompt for all flags or single flag "RTN","DGPFLMT",93,0) ;-- prompt for selection of a single flag or all flags "RTN","DGPFLMT",94,0) ; DGSORT("FLAG") = "A" or a flag variable pointer "RTN","DGPFLMT",95,0) ; list (A)ll flags if user selects Both Category's "RTN","DGPFLMT",96,0) S X=$P($$FLAG^DGPFUT7,U) I X'="A",X'="S" Q 0 "RTN","DGPFLMT",97,0) S DGSORT("FLAG")=X "RTN","DGPFLMT",98,0) ; "RTN","DGPFLMT",99,0) ; if single flag, now prompt for name of flag "RTN","DGPFLMT",100,0) I DGSORT("FLAG")="S" D I X<1 Q 0 "RTN","DGPFLMT",101,0) . S X=$$ONEFLAG^DGPFUT7("I",0) I X>0 S DGSORT("FLAG")=X "RTN","DGPFLMT",102,0) . Q "RTN","DGPFLMT",103,0) ; "RTN","DGPFLMT",104,0) ;-- setup filters, allow only active, locally owned assignments "RTN","DGPFLMT",105,0) S DGSORT("OWN")=1 "RTN","DGPFLMT",106,0) S DGSORT("STAT")=1 "RTN","DGPFLMT",107,0) ; "RTN","DGPFLMT",108,0) Q 1 "RTN","DGPFLMT1") 0^8^B68794802^B55169432 "RTN","DGPFLMT1",1,0) DGPFLMT1 ;ALB/RBS - PRF TRANSMISSION ERRORS BUILD LIST AREA ; 6/10/05 11:38am "RTN","DGPFLMT1",2,0) ;;5.3;Registration;**650,960**;Aug 13, 1993;Build 22 "RTN","DGPFLMT1",3,0) ; Last Edited: SHRPE/SGM - Jun 7, 2018 13:50 "RTN","DGPFLMT1",4,0) ; "RTN","DGPFLMT1",5,0) ; DG*5.3*960 - filter for only active and locally owned assignments "RTN","DGPFLMT1",6,0) ; GET modified for filters BLD modified for additional columns "RTN","DGPFLMT1",7,0) ; "RTN","DGPFLMT1",8,0) ;no direct entry "RTN","DGPFLMT1",9,0) QUIT "RTN","DGPFLMT1",10,0) ; "RTN","DGPFLMT1",11,0) ; "RTN","DGPFLMT1",12,0) EN(DGARY,DGSRTBY,DGCNT) ;Entry point to build list area "RTN","DGPFLMT1",13,0) ; "RTN","DGPFLMT1",14,0) ;The following input variables are 'system wide variables' in the "RTN","DGPFLMT1",15,0) ;DGPF TRANSMISSION ERRORS List Manager screen: "RTN","DGPFLMT1",16,0) ; "RTN","DGPFLMT1",17,0) ; Input: "RTN","DGPFLMT1",18,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",19,0) ; DGSRTBY - list sort by criteria "RTN","DGPFLMT1",20,0) ; "N" = Patient Name "RTN","DGPFLMT1",21,0) ; "D" = Date/Time Error Received "RTN","DGPFLMT1",22,0) ; Output: "RTN","DGPFLMT1",23,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",24,0) ; DGARY - ^TMP(DGARY,$J) - display list "RTN","DGPFLMT1",25,0) ; - ^TMP("DGPFSORT",$J) - used to create final DGARY list "RTN","DGPFLMT1",26,0) ; "RTN","DGPFLMT1",27,0) ;display wait msg "RTN","DGPFLMT1",28,0) D WAIT^DICD "RTN","DGPFLMT1",29,0) ; "RTN","DGPFLMT1",30,0) ;retrieve and sort "RTN","DGPFLMT1",31,0) D GET(DGSRTBY) "RTN","DGPFLMT1",32,0) ; "RTN","DGPFLMT1",33,0) ;build list "RTN","DGPFLMT1",34,0) D BLD(DGARY,DGSRTBY,.DGCNT) "RTN","DGPFLMT1",35,0) ; "RTN","DGPFLMT1",36,0) ;if no entries in list, display message "RTN","DGPFLMT1",37,0) I 'DGCNT D "RTN","DGPFLMT1",38,0) . D SET(DGARY,1,"",1,,,.DGCNT) "RTN","DGPFLMT1",39,0) . D SET(DGARY,2,"There are no transmission error messages on file.",3,$G(IOINHI),$G(IOINORM),.DGCNT) "RTN","DGPFLMT1",40,0) ; "RTN","DGPFLMT1",41,0) Q "RTN","DGPFLMT1",42,0) ; "RTN","DGPFLMT1",43,0) ; "RTN","DGPFLMT1",44,0) GET(DGSRTBY) ;Get "RJ" status entries. "RTN","DGPFLMT1",45,0) ; "RTN","DGPFLMT1",46,0) ; Input: "RTN","DGPFLMT1",47,0) ; DGSRTBY - list sort by value "RTN","DGPFLMT1",48,0) ; "RTN","DGPFLMT1",49,0) ; Output: "RTN","DGPFLMT1",50,0) ; ^TMP("DGPFSORT",$J,0,,,)="" "RTN","DGPFLMT1",51,0) ; "RTN","DGPFLMT1",52,0) ;The 0 node is created to group each patient's PRF Assignment record "RTN","DGPFLMT1",53,0) ;with each Site Transmitted To that is rejecting the update with all "RTN","DGPFLMT1",54,0) ;of the pointed to HL7 transmission log records. "RTN","DGPFLMT1",55,0) ;Only the most recent transmission log entry will be displayed. "RTN","DGPFLMT1",56,0) ; "RTN","DGPFLMT1",57,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",58,0) N DGDAT ;original transmission date "RTN","DGPFLMT1",59,0) N DGLIEN ;HL7 log record ien "RTN","DGPFLMT1",60,0) N DGPFA ;assignment array "RTN","DGPFLMT1",61,0) N DGPFAH ;assignment history data array "RTN","DGPFLMT1",62,0) N DGPFL ;HL7 transmission log data array "RTN","DGPFLMT1",63,0) N DGPFPAT ;patient data array "RTN","DGPFLMT1",64,0) N DGSITE ;site transmitted to ien "RTN","DGPFLMT1",65,0) N DGSSN ;patient ssn "RTN","DGPFLMT1",66,0) ; "RTN","DGPFLMT1",67,0) ;loop through ASTAT index of transmission date/times "RTN","DGPFLMT1",68,0) S DGDAT=0 "RTN","DGPFLMT1",69,0) F S DGDAT=$O(^DGPF(26.17,"ASTAT",DGDAT)) Q:'DGDAT D "RTN","DGPFLMT1",70,0) . Q:'$D(^DGPF(26.17,"ASTAT",DGDAT,"RJ")) "RTN","DGPFLMT1",71,0) . S DGLIEN=0 "RTN","DGPFLMT1",72,0) . F S DGLIEN=$O(^DGPF(26.17,"ASTAT",DGDAT,"RJ",DGLIEN)) Q:'DGLIEN D "RTN","DGPFLMT1",73,0) . . K DGPFL,DGPFAH "RTN","DGPFLMT1",74,0) . . ;- retrieve HL7 log data "RTN","DGPFLMT1",75,0) . . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFLMT1",76,0) . . Q:'+DGPFL("ASGNHIST") "RTN","DGPFLMT1",77,0) . . S DGSITE=$P($G(DGPFL("SITE")),U,1) "RTN","DGPFLMT1",78,0) . . Q:DGSITE']"" "RTN","DGPFLMT1",79,0) . . ;- retrieve assignment history data to get PRF Assignment ien "RTN","DGPFLMT1",80,0) . . Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFLMT1",81,0) . . S DGAIEN=$P($G(DGPFAH("ASSIGN")),U,1) "RTN","DGPFLMT1",82,0) . . Q:'DGAIEN "RTN","DGPFLMT1",83,0) . . ; "RTN","DGPFLMT1",84,0) . . ;- create 0 node by patient assignment, site ien and log ien "RTN","DGPFLMT1",85,0) . . S ^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,DGLIEN)="" "RTN","DGPFLMT1",86,0) ; "RTN","DGPFLMT1",87,0) Q:'$O(^TMP("DGPFSORT",$J,0,"")) ;quit if nothing setup "RTN","DGPFLMT1",88,0) ; "RTN","DGPFLMT1",89,0) ;- now loop the sorted 0 node and only use the most recent HL7 error "RTN","DGPFLMT1",90,0) ; record to create the List Manager display temp file. "RTN","DGPFLMT1",91,0) ; "RTN","DGPFLMT1",92,0) S DGAIEN=0 "RTN","DGPFLMT1",93,0) F S DGAIEN=$O(^TMP("DGPFSORT",$J,0,DGAIEN)) Q:DGAIEN="" D "RTN","DGPFLMT1",94,0) . S DGSITE=0 "RTN","DGPFLMT1",95,0) . F S DGSITE=$O(^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE)) Q:DGSITE="" D "RTN","DGPFLMT1",96,0) . . N X,Y "RTN","DGPFLMT1",97,0) . . K DGPFL,DGPFAH,DGPFA,DGPFPAT "RTN","DGPFLMT1",98,0) . . S DGLIEN=0 ;- get most recent record ien "RTN","DGPFLMT1",99,0) . . S DGLIEN=$O(^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,""),-1) "RTN","DGPFLMT1",100,0) . . Q:DGLIEN="" "RTN","DGPFLMT1",101,0) . . ;- retrieve HL7 log data "RTN","DGPFLMT1",102,0) . . Q:'$$GETLOG^DGPFHLL(DGLIEN,.DGPFL) "RTN","DGPFLMT1",103,0) . . ;- retrieve assignment file data to get Owner Site "RTN","DGPFLMT1",104,0) . . Q:'$$GETASGN^DGPFAA(DGAIEN,.DGPFA) "RTN","DGPFLMT1",105,0) . . ;- retrieve patient data to get ssn "RTN","DGPFLMT1",106,0) . . Q:'$$GETPAT^DGPFUT2(+DGPFA("DFN"),.DGPFPAT) "RTN","DGPFLMT1",107,0) . . S DGSSN=$G(DGPFPAT("SSN")) S:'DGSSN DGSSN="UNKNOWN" "RTN","DGPFLMT1",108,0) . . ;- add ssn to existing array "RTN","DGPFLMT1",109,0) . . S DGPFA("SSN")=DGSSN "RTN","DGPFLMT1",110,0) . . ;- retrieve assignment history data "RTN","DGPFLMT1",111,0) . . Q:'$$GETHIST^DGPFAAH(+DGPFL("ASGNHIST"),.DGPFAH) "RTN","DGPFLMT1",112,0) . . ; "RTN","DGPFLMT1",113,0) . . ;- DG*5.3*960 - FILTER check "RTN","DGPFLMT1",114,0) . . ; STAT: 1:active; 0:inactive "RTN","DGPFLMT1",115,0) . . ; OWN: 1:Owner local facility; 0:Owner not local "RTN","DGPFLMT1",116,0) . . ; FLAG: "A" or flag variable pointer "RTN","DGPFLMT1",117,0) . . S X=$G(DGSORT("STAT")) I X?1N,+DGPFA("STATUS")'=X Q "RTN","DGPFLMT1",118,0) . . S X=$G(DGSORT("OWN")) I X?1N D Q:'Y "RTN","DGPFLMT1",119,0) . . . S Y=+DGPFA("OWNER"),Y=$S(Y<1:0,1:$$ISDIV^DGPFUT(Y)) "RTN","DGPFLMT1",120,0) . . . I X=1,Y>0 Q "RTN","DGPFLMT1",121,0) . . . I X=0 S Y=$S(Y>0:0,1:1) "RTN","DGPFLMT1",122,0) . . . Q "RTN","DGPFLMT1",123,0) . . S X=$G(DGSORT("FLAG")) I +X,$P(X,U)'=$P(DGPFA("FLAG"),U) Q "RTN","DGPFLMT1",124,0) . . ; "RTN","DGPFLMT1",125,0) . . ;- setup output array "RTN","DGPFLMT1",126,0) . . D SORT(DGLIEN,DGSRTBY,.DGPFA,.DGPFAH,.DGPFL) "RTN","DGPFLMT1",127,0) . . Q "RTN","DGPFLMT1",128,0) . Q "RTN","DGPFLMT1",129,0) ; "RTN","DGPFLMT1",130,0) Q "RTN","DGPFLMT1",131,0) ; "RTN","DGPFLMT1",132,0) ; "RTN","DGPFLMT1",133,0) SORT(DGLIEN,DGSRTBY,DGPFA,DGPFAH,DGPFL) ;Setup output global "RTN","DGPFLMT1",134,0) ; "RTN","DGPFLMT1",135,0) ; Input: "RTN","DGPFLMT1",136,0) ; DGLIEN - ien of HL7 log record "RTN","DGPFLMT1",137,0) ; DGSRTBY - list sort value "RTN","DGPFLMT1",138,0) ; DGPFA - assignment array "RTN","DGPFLMT1",139,0) ; DGPFAH - assignment history array "RTN","DGPFLMT1",140,0) ; DGPFL - HL7 log array "RTN","DGPFLMT1",141,0) ; "RTN","DGPFLMT1",142,0) ; Output: "RTN","DGPFLMT1",143,0) ; ^TMP("DGPFSORT",$J,1,S4,S5,S6,S7) = data string values "RTN","DGPFLMT1",144,0) ; Subscript's are as follows for each sort by: "RTN","DGPFLMT1",145,0) ; "RTN","DGPFLMT1",146,0) ; List by patient name List by HL7 received d/t "RTN","DGPFLMT1",147,0) ; Sort="N" Sort="D" "RTN","DGPFLMT1",148,0) ; -------------------- ------------------------ "RTN","DGPFLMT1",149,0) ; S4 patient_name ack_received_d/t "RTN","DGPFLMT1",150,0) ; S5 assignment_ien assignment_ien "RTN","DGPFLMT1",151,0) ; S6 site_ien site_transmitted_to "RTN","DGPFLMT1",152,0) ; S7 HL7_log_ien HL7_log_ien "RTN","DGPFLMT1",153,0) ; "RTN","DGPFLMT1",154,0) ; The data string value consists of 5 "^"-pieces "RTN","DGPFLMT1",155,0) ; DFN ^ Patient_name ^ SSN ^ Ack_received_dt ^ Site_transmitted_to "RTN","DGPFLMT1",156,0) ; "RTN","DGPFLMT1",157,0) N DGACKDT ;d/t error msg received "RTN","DGPFLMT1",158,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",159,0) N DGPNAME ;patient name "RTN","DGPFLMT1",160,0) N DGSITE ;site transmitted to ien "RTN","DGPFLMT1",161,0) N DGSTRING ;detail line "RTN","DGPFLMT1",162,0) N DGSUB ;subscript var "RTN","DGPFLMT1",163,0) ; "RTN","DGPFLMT1",164,0) ;- subscript setup "RTN","DGPFLMT1",165,0) S DGACKDT=$P($G(DGPFL("ACKDT")),U) S:DGACKDT="" DGACKDT="UNKNOWN" "RTN","DGPFLMT1",166,0) S DGAIEN=$P($G(DGPFAH("ASSIGN")),U) S:DGAIEN="" DGAIEN="UNKNOWN" "RTN","DGPFLMT1",167,0) S DGPNAME=$P($G(DGPFA("DFN")),U,2) S:DGPNAME="" DGPNAME="UNKNOWN" "RTN","DGPFLMT1",168,0) S DGSITE=$P($G(DGPFL("SITE")),U) "RTN","DGPFLMT1",169,0) ; "RTN","DGPFLMT1",170,0) ;- data string setup - "RTN","DGPFLMT1",171,0) S DGSTRING=$P($G(DGPFA("DFN")),U) "RTN","DGPFLMT1",172,0) S $P(DGSTRING,U,2)=DGPNAME "RTN","DGPFLMT1",173,0) S $P(DGSTRING,U,3)=$P($G(DGPFA("SSN")),U) "RTN","DGPFLMT1",174,0) S $P(DGSTRING,U,4)=DGACKDT "RTN","DGPFLMT1",175,0) S $P(DGSTRING,U,5)=$P($G(DGPFL("SITE")),U,2) "RTN","DGPFLMT1",176,0) ; "RTN","DGPFLMT1",177,0) ;- patient name sort "RTN","DGPFLMT1",178,0) I DGSRTBY="N" S DGSUB=DGPNAME "RTN","DGPFLMT1",179,0) ;- date/time error received type sort "RTN","DGPFLMT1",180,0) I DGSRTBY="D" S DGSUB=DGACKDT "RTN","DGPFLMT1",181,0) ; "RTN","DGPFLMT1",182,0) S ^TMP("DGPFSORT",$J,1,DGSUB,DGAIEN,DGSITE,DGLIEN)=DGSTRING "RTN","DGPFLMT1",183,0) Q "RTN","DGPFLMT1",184,0) ; "RTN","DGPFLMT1",185,0) ; "RTN","DGPFLMT1",186,0) BLD(DGARY,DGSRTBY,DGCNT) ;Build list area "RTN","DGPFLMT1",187,0) ; "RTN","DGPFLMT1",188,0) ; Input: "RTN","DGPFLMT1",189,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",190,0) ; DGSRTBY - list sort by value "RTN","DGPFLMT1",191,0) ; "RTN","DGPFLMT1",192,0) ; Output: "RTN","DGPFLMT1",193,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",194,0) ; DGARY - display list - ^TMP(DGARY,$J) "RTN","DGPFLMT1",195,0) ; "RTN","DGPFLMT1",196,0) N DGACKDT ;d/t error msg received "RTN","DGPFLMT1",197,0) N DGAIEN ;assignment ien "RTN","DGPFLMT1",198,0) N DGLAST ;date of last activation action "RTN","DGPFLMT1",199,0) N DGLIEN ;log record ien "RTN","DGPFLMT1",200,0) N DGLINE ;line counter "RTN","DGPFLMT1",201,0) N DGORIG ;original assignment date "RTN","DGPFLMT1",202,0) N DGOWNER ;owner of assignment "RTN","DGPFLMT1",203,0) N DGPNAME ;patient name "RTN","DGPFLMT1",204,0) N DGSIEN ;site ien "RTN","DGPFLMT1",205,0) N DGSITE ;site transmitted to name "RTN","DGPFLMT1",206,0) N DGSSN ;patient ssn "RTN","DGPFLMT1",207,0) N DGSTRING ;detail line "RTN","DGPFLMT1",208,0) N DGSUB ;loop var "RTN","DGPFLMT1",209,0) N DGTEMP ;sort array root "RTN","DGPFLMT1",210,0) ; "RTN","DGPFLMT1",211,0) S DGTEMP=$NA(^TMP("DGPFSORT",$J,1)) "RTN","DGPFLMT1",212,0) S DGSUB="",DGLINE=0 "RTN","DGPFLMT1",213,0) ; "RTN","DGPFLMT1",214,0) F S DGSUB=$O(@DGTEMP@(DGSUB)) Q:DGSUB="" D "RTN","DGPFLMT1",215,0) . S DGAIEN=0 "RTN","DGPFLMT1",216,0) . F S DGAIEN=$O(@DGTEMP@(DGSUB,DGAIEN)) Q:'DGAIEN D "RTN","DGPFLMT1",217,0) . . S DGORIG=$$GETADT^DGPFAAH(DGAIEN) "RTN","DGPFLMT1",218,0) . . S DGSIEN=0 "RTN","DGPFLMT1",219,0) . . F S DGSIEN=$O(@DGTEMP@(DGSUB,DGAIEN,DGSIEN)) Q:'DGSIEN D "RTN","DGPFLMT1",220,0) . . . S DGLIEN=0 "RTN","DGPFLMT1",221,0) . . . F S DGLIEN=$O(@DGTEMP@(DGSUB,DGAIEN,DGSIEN,DGLIEN)) Q:'DGLIEN D "RTN","DGPFLMT1",222,0) . . . . N X "RTN","DGPFLMT1",223,0) . . . . ;- get data fields "RTN","DGPFLMT1",224,0) . . . . S DGSTRING=$G(@DGTEMP@(DGSUB,DGAIEN,DGSIEN,DGLIEN)) "RTN","DGPFLMT1",225,0) . . . . S DGPNAME=$P(DGSTRING,U,2) "RTN","DGPFLMT1",226,0) . . . . S DGSSN=$E($P(DGSTRING,U,3),6,9) "RTN","DGPFLMT1",227,0) . . . . S DGACKDT=$$FMTE^XLFDT($P(DGSTRING,U,4)\1,"2Z") "RTN","DGPFLMT1",228,0) . . . . S DGSITE=$E($P(DGSTRING,U,5),1,27) "RTN","DGPFLMT1",229,0) . . . . ;- increment line counter "RTN","DGPFLMT1",230,0) . . . . S DGLINE=DGLINE+1 "RTN","DGPFLMT1",231,0) . . . . ;- set line into list area "RTN","DGPFLMT1",232,0) . . . . ;- format of display line, 2 spaces between columns "RTN","DGPFLMT1",233,0) . . . . ; 1-3 6-35 38-41 44-51 54-80 "RTN","DGPFLMT1",234,0) . . . . ; line# patient ssn Reject_date Transmit_to "RTN","DGPFLMT1",235,0) . . . . D SET(DGARY,DGLINE,DGLINE,1,,,.DGCNT) "RTN","DGPFLMT1",236,0) . . . . D SET(DGARY,DGLINE,DGPNAME,6,,,.DGCNT) "RTN","DGPFLMT1",237,0) . . . . D SET(DGARY,DGLINE,DGSSN,38,,,.DGCNT) "RTN","DGPFLMT1",238,0) . . . . D SET(DGARY,DGLINE,DGACKDT,44,,,.DGCNT) "RTN","DGPFLMT1",239,0) . . . . D SET(DGARY,DGLINE,DGSITE,54,,,.DGCNT) "RTN","DGPFLMT1",240,0) . . . . ; "RTN","DGPFLMT1",241,0) . . . . ;- associate "IDX" list item entry with the pointer's "RTN","DGPFLMT1",242,0) . . . . ; back to ^TMP("DGPFSORT",$J,0,DGAIEN,DGSITE,DGLIEN) global: "RTN","DGPFLMT1",243,0) . . . . ; ^^^^pat name^site name "RTN","DGPFLMT1",244,0) . . . . S ^TMP(DGARY,$J,"IDX",DGLINE,DGLINE)=DGAIEN_U_DGSIEN_U_DGLIEN_U_$P(DGSTRING,U,1)_U_DGPNAME_U_$P(DGSTRING,U,5) "RTN","DGPFLMT1",245,0) ; "RTN","DGPFLMT1",246,0) ;cleanup temp sort global "RTN","DGPFLMT1",247,0) K @DGTEMP "RTN","DGPFLMT1",248,0) Q "RTN","DGPFLMT1",249,0) ; "RTN","DGPFLMT1",250,0) ; "RTN","DGPFLMT1",251,0) SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGCNT) ;Setup display detail lines "RTN","DGPFLMT1",252,0) ; "RTN","DGPFLMT1",253,0) ; Input: "RTN","DGPFLMT1",254,0) ; DGARY - subscript name for temp global "RTN","DGPFLMT1",255,0) ; DGLINE - line number "RTN","DGPFLMT1",256,0) ; DGTEXT - text "RTN","DGPFLMT1",257,0) ; DGCOL - starting column "RTN","DGPFLMT1",258,0) ; DGON - highlighting on "RTN","DGPFLMT1",259,0) ; DGOFF - highlighting off "RTN","DGPFLMT1",260,0) ; "RTN","DGPFLMT1",261,0) ; Output: "RTN","DGPFLMT1",262,0) ; DGARY - temp global array of LM detail lines "RTN","DGPFLMT1",263,0) ; DGCNT - number of lines in the list "RTN","DGPFLMT1",264,0) ; "RTN","DGPFLMT1",265,0) N DGX ;string to insert new text into "RTN","DGPFLMT1",266,0) ; "RTN","DGPFLMT1",267,0) S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"") "RTN","DGPFLMT1",268,0) S DGCNT=DGLINE "RTN","DGPFLMT1",269,0) ; "RTN","DGPFLMT1",270,0) S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT)) "RTN","DGPFLMT1",271,0) ; "RTN","DGPFLMT1",272,0) D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF)) "RTN","DGPFLMT1",273,0) ; "RTN","DGPFLMT1",274,0) Q "RTN","DGPFRAL") 0^1^B36782112^B10972020 "RTN","DGPFRAL",1,0) DGPFRAL ;ALB/RBS - PRF ACTION NOT LINKED REPORT ; 7/26/05 3:18pm "RTN","DGPFRAL",2,0) ;;5.3;Registration;**554,960**;Aug 13, 1993;Build 22 "RTN","DGPFRAL",3,0) ; Last Edited: SHRPE/SGM - Jun 29,2018 15:14 "RTN","DGPFRAL",4,0) ; "RTN","DGPFRAL",5,0) ; ICR# TYPE DESCRIIPTION "RTN","DGPFRAL",6,0) ;----- ---- ---------------------------- "RTN","DGPFRAL",7,0) ; 1519 Sup EN^XUTMDEVQ "RTN","DGPFRAL",8,0) ;10006 Sup ^DIC "RTN","DGPFRAL",9,0) ;10086 Sup HOME^%ZIS "RTN","DGPFRAL",10,0) ; "RTN","DGPFRAL",11,0) ;This routine will be used for selecting sort parameters to produce "RTN","DGPFRAL",12,0) ;the DGPF ACTION NOT LINKED REPORT for Patient Record Flags. "RTN","DGPFRAL",13,0) ; "RTN","DGPFRAL",14,0) ; Selection options will provide the ability to report by: "RTN","DGPFRAL",15,0) ; CATEGORY "RTN","DGPFRAL",16,0) ; BEGINNING DATE "RTN","DGPFRAL",17,0) ; ENDING DATE "RTN","DGPFRAL",18,0) ; "RTN","DGPFRAL",19,0) ; The following reporting sort array will be built by user prompts: "RTN","DGPFRAL",20,0) ; DGSORT("DGCAT") = 1^Category I (National) "RTN","DGPFRAL",21,0) ; 2^Category II (Local) "RTN","DGPFRAL",22,0) ; 3^Both "RTN","DGPFRAL",23,0) ; DGSORT("DGBEG") = BEGINNING DATE (internal FileMan date) "RTN","DGPFRAL",24,0) ; DGSORT("DGEND") = ENDING DATE (internal FileMan date) "RTN","DGPFRAL",25,0) ; DGSORT("DGFAC") = 1^Local Facility Only "RTN","DGPFRAL",26,0) ; 2^Other Facilities "RTN","DGPFRAL",27,0) ; 3^Both "RTN","DGPFRAL",28,0) ; DGSORT("DGFLG") = "" for all flags "RTN","DGPFRAL",29,0) ; Else pointer^name^variable_pointer "RTN","DGPFRAL",30,0) ; DGSORT("DGSTA") = 0^Inactive "RTN","DGPFRAL",31,0) ; 1^Active "RTN","DGPFRAL",32,0) ; 2^Both "RTN","DGPFRAL",33,0) ; "RTN","DGPFRAL",34,0) ;-- no direct entry "RTN","DGPFRAL",35,0) QUIT "RTN","DGPFRAL",36,0) ; "RTN","DGPFRAL",37,0) EN ;Entry point "RTN","DGPFRAL",38,0) ;-- user prompts for report selection sorts "RTN","DGPFRAL",39,0) ; DG*5.3*960 - $$FLAGONE, $$STATUS, $$TYPE "RTN","DGPFRAL",40,0) ; Input: none "RTN","DGPFRAL",41,0) ; Output: Report generated using user selected parameters "RTN","DGPFRAL",42,0) ; "RTN","DGPFRAL",43,0) N DGFIRST ;first assignment date "RTN","DGPFRAL",44,0) N DGSEL ;help text var "RTN","DGPFRAL",45,0) N DGSORT ;array or report parameters "RTN","DGPFRAL",46,0) N ZTSAVE ;open array reference of input parameters used by tasking "RTN","DGPFRAL",47,0) N X,Y "RTN","DGPFRAL",48,0) ; "RTN","DGPFRAL",49,0) S DGFIRST=$P(+$O(^DGPF(26.14,"D","")),".") ;first assignment date "RTN","DGPFRAL",50,0) I 'DGFIRST D Q "RTN","DGPFRAL",51,0) . D E(">>> No Patient Record Flag Assignments have been found.") "RTN","DGPFRAL",52,0) . Q "RTN","DGPFRAL",53,0) ;-- prompt for selection of a flag category "RTN","DGPFRAL",54,0) I '$$FLAG Q ; Returns DGSORT("DGCAT") "RTN","DGPFRAL",55,0) ; "RTN","DGPFRAL",56,0) ;-- prompt for a single flag, else all flags "RTN","DGPFRAL",57,0) I $$FLAGONE<0 Q ; DGSORT("DGFLG") "RTN","DGPFRAL",58,0) ; "RTN","DGPFRAL",59,0) ;-- prompt for beginning date "RTN","DGPFRAL",60,0) W ! I '$$DATEBEG Q ; DGSORT("DGBEG") "RTN","DGPFRAL",61,0) ; "RTN","DGPFRAL",62,0) ;-- prompt for ending date "RTN","DGPFRAL",63,0) I '$$DATEEND Q ; DGSORT("DGEND") "RTN","DGPFRAL",64,0) ; "RTN","DGPFRAL",65,0) ;-- prompt for flag status "RTN","DGPFRAL",66,0) I '$$STATUS Q ; DGSORT("DGSTA") "RTN","DGPFRAL",67,0) ; "RTN","DGPFRAL",68,0) ;-- prompt for type of History records "RTN","DGPFRAL",69,0) I '$$TYPE Q ; DGSORT("DGFAC") "RTN","DGPFRAL",70,0) ; "RTN","DGPFRAL",71,0) ;-- prompt for device "RTN","DGPFRAL",72,0) S ZTSAVE("DGSORT(")="" "RTN","DGPFRAL",73,0) S X="Assignment Action Not Linked to a Progress Note Report" "RTN","DGPFRAL",74,0) D EN^XUTMDEVQ("START^DGPFRAL1",X,.ZTSAVE) "RTN","DGPFRAL",75,0) D HOME^%ZIS "RTN","DGPFRAL",76,0) Q "RTN","DGPFRAL",77,0) ; "RTN","DGPFRAL",78,0) ;----------------------- PRIVATE SUBROUTINES ----------------------- "RTN","DGPFRAL",79,0) HELP(DGSEL) ;provide extended DIR("?") help text. "RTN","DGPFRAL",80,0) ; "RTN","DGPFRAL",81,0) ; Input: DGSEL - prompt var for help text word selection "RTN","DGPFRAL",82,0) ; Output: none "RTN","DGPFRAL",83,0) ; "RTN","DGPFRAL",84,0) N X S X=$S(DGSEL=1:"earliest",1:"latest") "RTN","DGPFRAL",85,0) W !," Enter "_X_" Assignment Action Date to include in the report." "RTN","DGPFRAL",86,0) W !," Please enter a date from the specified date range displayed." "RTN","DGPFRAL",87,0) Q "RTN","DGPFRAL",88,0) ; "RTN","DGPFRAL",89,0) E(TX) ; press ENTER to continue prompt "RTN","DGPFRAL",90,0) I $L(TX) W !?2,TX_$C(7) "RTN","DGPFRAL",91,0) I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") "RTN","DGPFRAL",92,0) Q "RTN","DGPFRAL",93,0) ; "RTN","DGPFRAL",94,0) DATEBEG() ;-- prompt for beginning date "RTN","DGPFRAL",95,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFRAL",96,0) S DGDIRA="Select Beginning Date" "RTN","DGPFRAL",97,0) S DGDIRB="" "RTN","DGPFRAL",98,0) S DGDIRH="^D HELP^DGPFRAL(1)" "RTN","DGPFRAL",99,0) S DGDIRO="D^"_DGFIRST_":DT:EX" "RTN","DGPFRAL",100,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRAL",101,0) I DGASK>0 S DGSORT("DGBEG")=DGASK "RTN","DGPFRAL",102,0) Q DGASK>0 "RTN","DGPFRAL",103,0) ; "RTN","DGPFRAL",104,0) DATEEND() ;-- prompt for ending date "RTN","DGPFRAL",105,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFRAL",106,0) S DGDIRA="Select Ending Date" "RTN","DGPFRAL",107,0) S DGDIRB="" "RTN","DGPFRAL",108,0) S DGDIRH="^D HELP^DGPFRAL(2)" "RTN","DGPFRAL",109,0) S DGDIRO="D^"_DGSORT("DGBEG")_":DT:EX" "RTN","DGPFRAL",110,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRAL",111,0) I DGASK>0 S DGSORT("DGEND")=DGASK "RTN","DGPFRAL",112,0) Q DGASK>0 "RTN","DGPFRAL",113,0) ; "RTN","DGPFRAL",114,0) FLAG() ;-- prompt for selection of a flag category "RTN","DGPFRAL",115,0) ;;1:Category I (National);2:Category II (Local);3:Both (Category I & II) "RTN","DGPFRAL",116,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFRAL",117,0) S DGDIRA="Select Flag Category" "RTN","DGPFRAL",118,0) S DGDIRB="" "RTN","DGPFRAL",119,0) S DGDIRH="Enter one of the category selections to report on" "RTN","DGPFRAL",120,0) S DGDIRO="S^"_$P($T(FLAG+1),";",3,9) "RTN","DGPFRAL",121,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRAL",122,0) I DGASK>0 S DGSORT("DGCAT")=$$PIECE(DGDIRO,DGASK) "RTN","DGPFRAL",123,0) Q DGASK>0 "RTN","DGPFRAL",124,0) ; "RTN","DGPFRAL",125,0) ;--- start code addition by DG*5.3*960 "RTN","DGPFRAL",126,0) FLAGONE() ;-- prompt for a single flag "RTN","DGPFRAL",127,0) ;; "RTN","DGPFRAL",128,0) ;;Press [ENTER] to run report for all flags "RTN","DGPFRAL",129,0) ;;Select a single flag name for the report "RTN","DGPFRAL",130,0) ;;Enter '^' to exit back to your primary menu "RTN","DGPFRAL",131,0) ;; "RTN","DGPFRAL",132,0) N I,X,Y,Z,CAT,DIC,DTOUT,DUOUT "RTN","DGPFRAL",133,0) S DGSORT("DGFLG")="" "RTN","DGPFRAL",134,0) S CAT=+DGSORT("DGCAT") I CAT'=1,CAT'=2 Q 1 "RTN","DGPFRAL",135,0) F I=1:1:5 W !,$TR($T(FLAGONE+I),";"," ") "RTN","DGPFRAL",136,0) S DIC=$P("26.15^26.11",U,CAT) "RTN","DGPFRAL",137,0) S DIC(0)="QAEM" "RTN","DGPFRAL",138,0) S DIC("A")="Select Category "_$E("II",1,CAT)_" Flag: " "RTN","DGPFRAL",139,0) D ^DIC W ! "RTN","DGPFRAL",140,0) I Y>0 S DGSORT("DGFLG")=Y_U_(+Y)_";"_$P(DIC,U,2) "RTN","DGPFRAL",141,0) Q Y>0 "RTN","DGPFRAL",142,0) ; "RTN","DGPFRAL",143,0) STATUS() ;-- prompt for flag status "RTN","DGPFRAL",144,0) N DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFRAL",145,0) S DGDIRA="Choose Flag Status" "RTN","DGPFRAL",146,0) S DGDIRB="" "RTN","DGPFRAL",147,0) S DGDIRH="Enter which statuses to report on" "RTN","DGPFRAL",148,0) S DGDIRO="S^1:Inactive;2:Active;3:Both active and inactive" "RTN","DGPFRAL",149,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFRAL",150,0) I DGASK>0 S DGSORT("DGSTA")=$$PIECE(DGDIRO,DGASK) "RTN","DGPFRAL",151,0) Q DGASK>0 "RTN","DGPFRAL",152,0) ; "RTN","DGPFRAL",153,0) TYPE() ;-- prompt for type of history records "RTN","DGPFRAL",154,0) I +DGSORT("DGCAT")=2 S DGSORT("DGFAC")="1^Local Facility" Q 1 "RTN","DGPFRAL",155,0) ; "RTN","DGPFRAL",156,0) N X,DGASK,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFRAL",157,0) S DGDIRA="Choose Type of History Record" "RTN","DGPFRAL",158,0) S DGDIRB="" "RTN","DGPFRAL",159,0) S DGDIRH="^D TYPEH^DGPFRAL" "RTN","DGPFRAL",160,0) S X="S^1:Actions performed by local facility only;" "RTN","DGPFRAL",161,0) S X=X_"2:Actions performed by other facilities;" "RTN","DGPFRAL",162,0) S X=X_"3:Actions performed by all facilities" "RTN","DGPFRAL",163,0) S DGDIRO=X "RTN","DGPFRAL",164,0) S DGASK=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) I DGASK>0 D "RTN","DGPFRAL",165,0) . S X=$P("Local Facility^Other Facilities^All Facilities",U,DGASK) "RTN","DGPFRAL",166,0) . S DGSORT("DGFAC")=DGASK_U_X "RTN","DGPFRAL",167,0) . Q "RTN","DGPFRAL",168,0) Q DGASK>0 "RTN","DGPFRAL",169,0) ; "RTN","DGPFRAL",170,0) TYPEH ; provide extended DIR("?") help for facility type "RTN","DGPFRAL",171,0) ;;Enter the type of History Action records to display: "RTN","DGPFRAL",172,0) ;; "RTN","DGPFRAL",173,0) ;; Local: records created by this VAMC "RTN","DGPFRAL",174,0) ;; Other: records created by other VAMCs, not this VAMC "RTN","DGPFRAL",175,0) ;; Both: means to show all history records with no regard "RTN","DGPFRAL",176,0) ;; for the facility that created them "RTN","DGPFRAL",177,0) ;; "RTN","DGPFRAL",178,0) N I F I=1:1:7 W !,$TR($T(HELPT+I),";"," ") "RTN","DGPFRAL",179,0) Q "RTN","DGPFRAL",180,0) ; "RTN","DGPFRAL",181,0) PIECE(DGIR0,DGASK) ; "RTN","DGPFRAL",182,0) N X "RTN","DGPFRAL",183,0) S X=$P(DGIR0,U,2) "RTN","DGPFRAL",184,0) S X=$P(X,";",DGASK) "RTN","DGPFRAL",185,0) S X=$P(X,":",2) "RTN","DGPFRAL",186,0) Q DGASK_U_X "RTN","DGPFRAL1") 0^2^B101428491^B80104203 "RTN","DGPFRAL1",1,0) DGPFRAL1 ;ALB/RBS - PRF ACTION NOT LINKED REPORT CONT. ; 10/12/05 2:48pm "RTN","DGPFRAL1",2,0) ;;5.3;Registration;**554,650,892,960**;Aug 13, 1993;Build 22 "RTN","DGPFRAL1",3,0) ; Last Edited: SHRPE/SGM - July 9, 2018 15:55 "RTN","DGPFRAL1",4,0) ; "RTN","DGPFRAL1",5,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFRAL1",6,0) ;----- ---- --------------------- "RTN","DGPFRAL1",7,0) ;2171 Sup $$STA^XUAF4 "RTN","DGPFRAL1",8,0) ;10024 Sup WAIT^DICD "RTN","DGPFRAL1",9,0) ;10063 Sup $$S^%ZTLOAD "RTN","DGPFRAL1",10,0) ;10086 Sup HOME^%ZIS "RTN","DGPFRAL1",11,0) ;10089 Sup ^%ZISC "RTN","DGPFRAL1",12,0) ;10103 Sup ^XLFDT: $$FMTE, $$NOW "RTN","DGPFRAL1",13,0) ;10112 Sup $$SITE^VASITE "RTN","DGPFRAL1",14,0) ; "RTN","DGPFRAL1",15,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRAL1",16,0) ;assignment history records that are not linked to a progress note. "RTN","DGPFRAL1",17,0) ; "RTN","DGPFRAL1",18,0) ; INPUT: DGSORT() - see comments at the top of routine DGPFRAL for "RTN","DGPFRAL1",19,0) ; explanation of DGSORT array "RTN","DGPFRAL1",20,0) ; "RTN","DGPFRAL1",21,0) ; Output: A formatted report of patient Assignment History Actions "RTN","DGPFRAL1",22,0) ; that are not linked to a TIU Progress Note. "RTN","DGPFRAL1",23,0) ; "RTN","DGPFRAL1",24,0) ;- no direct entry "RTN","DGPFRAL1",25,0) QUIT "RTN","DGPFRAL1",26,0) ; "RTN","DGPFRAL1",27,0) START ; compile and print report "RTN","DGPFRAL1",28,0) N DGLIST,DGQ,HD,TRM "RTN","DGPFRAL1",29,0) D INIT "RTN","DGPFRAL1",30,0) D LOOP I 'DGQ D PRINT(.DGSORT,DGLIST) "RTN","DGPFRAL1",31,0) ; "RTN","DGPFRAL1",32,0) EXIT ; "RTN","DGPFRAL1",33,0) K @DGLIST "RTN","DGPFRAL1",34,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRAL1",35,0) I 'DGQ,TRM S X=$$E^DGPFUT7 W @IOF "RTN","DGPFRAL1",36,0) I 'TRM,$Y>0 W @IOF "RTN","DGPFRAL1",37,0) Q "RTN","DGPFRAL1",38,0) ; "RTN","DGPFRAL1",39,0) LOOP ;use sort var's for record searching to build list "RTN","DGPFRAL1",40,0) ; Input: "RTN","DGPFRAL1",41,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",42,0) ; DGLIST - temp global name "RTN","DGPFRAL1",43,0) ; "RTN","DGPFRAL1",44,0) ; Output: "RTN","DGPFRAL1",45,0) ; ^TMP("DGPFRAL1",$J) - temp global containing report output "RTN","DGPFRAL1",46,0) ; "RTN","DGPFRAL1",47,0) N DGBEG ;beginning date "RTN","DGPFRAL1",48,0) N DGC ;var used to check which category is being reported on "RTN","DGPFRAL1",49,0) N DGCAT ;flag category "RTN","DGPFRAL1",50,0) N DGCATG ;category 1 or 2 "RTN","DGPFRAL1",51,0) N DGCNT ;flag counter "RTN","DGPFRAL1",52,0) N DGDFN ;pointer to patient being reported on "RTN","DGPFRAL1",53,0) N DGDFNLST ;array of dfn's assigned to the flag "RTN","DGPFRAL1",54,0) N DGEND ;ending date "RTN","DGPFRAL1",55,0) N DGHIENS ;array subscripted by assignment history date "RTN","DGPFRAL1",56,0) N DGIEN ;assignment ien "RTN","DGPFRAL1",57,0) N DGPAT ;patient data array "RTN","DGPFRAL1",58,0) N DGPFA ;assignment data array "RTN","DGPFRAL1",59,0) N DGSUB ;loop flag "RTN","DGPFRAL1",60,0) N DGX ;loop var "RTN","DGPFRAL1",61,0) ; "RTN","DGPFRAL1",62,0) ; setup variables equal to user input parameter subscripts "RTN","DGPFRAL1",63,0) ; "DGCAT", "DGBEG", "DGEND" "RTN","DGPFRAL1",64,0) S DGX="" F S DGX=$O(DGSORT(DGX)) Q:DGX="" S @DGX=DGSORT(DGX) "RTN","DGPFRAL1",65,0) S DGC=$S(+DGCAT=3:0,1:+DGCAT) "RTN","DGPFRAL1",66,0) S:DGC DGC=$S(DGC=1:26.15,1:26.11) "RTN","DGPFRAL1",67,0) N DGI S DGI=0 "RTN","DGPFRAL1",68,0) ; "RTN","DGPFRAL1",69,0) ; loop assignment variable pointer flag x-ref file to run report "RTN","DGPFRAL1",70,0) S (DGDFN,DGIEN)="",(DGSUB,DGCNT)=0 "RTN","DGPFRAL1",71,0) F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRAL1",72,0) . I DGC,DGSUB'[DGC Q ;not correct file based on category "RTN","DGPFRAL1",73,0) . S DGCATG=$S(DGSUB[26.15:1,1:2) "RTN","DGPFRAL1",74,0) . K DGDFNLST "RTN","DGPFRAL1",75,0) . S DGCNT=$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) "RTN","DGPFRAL1",76,0) . Q:'DGCNT "RTN","DGPFRAL1",77,0) . S DGDFN="" "RTN","DGPFRAL1",78,0) . F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D Q:DGQ "RTN","DGPFRAL1",79,0) . . S DGI=1+DGI I '(DGI#200) D CHK Q:DGQ "RTN","DGPFRAL1",80,0) . . S DGIEN=$G(DGDFNLST(DGDFN)) Q:DGIEN="" "RTN","DGPFRAL1",81,0) . . ; get assignment record "RTN","DGPFRAL1",82,0) . . K DGPFA "RTN","DGPFRAL1",83,0) . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRAL1",84,0) . . ; check if calling site is owner site "RTN","DGPFRAL1",85,0) . . Q:'$$ISDIV^DGPFUT($P(DGPFA("OWNER"),U)) "RTN","DGPFRAL1",86,0) . . ; "RTN","DGPFRAL1",87,0) . . ;filter patient when last action is ENTERED IN ERROR "RTN","DGPFRAL1",88,0) . . Q:$$ENTINERR(DGIEN) "RTN","DGPFRAL1",89,0) . . ; "RTN","DGPFRAL1",90,0) . . ;filter for single flag - DG*5.3*960 "RTN","DGPFRAL1",91,0) . . Q:'$$FLAGNM($P(DGPFA("FLAG"),U)) "RTN","DGPFRAL1",92,0) . . ; "RTN","DGPFRAL1",93,0) . . ;filter on assignment status - DG*5.3*960 "RTN","DGPFRAL1",94,0) . . Q:'$$STATUS(+DGPFA("STATUS")) "RTN","DGPFRAL1",95,0) . . ; "RTN","DGPFRAL1",96,0) . . ;action ien array subscripted by assignment history date "RTN","DGPFRAL1",97,0) . . K DGHIENS "RTN","DGPFRAL1",98,0) . . Q:'$$GETALLDT^DGPFAAH(DGIEN,.DGHIENS) "RTN","DGPFRAL1",99,0) . . ; check if any Action's fall within the Begin and End dates "RTN","DGPFRAL1",100,0) . . I $P($O(DGHIENS("")),".")'>DGEND&($P($O(DGHIENS(""),-1),".")'DGEND) K DGHIENS(DGX) "RTN","DGPFRAL1",104,0) . . . Q:'$O(DGHIENS("")) "RTN","DGPFRAL1",105,0) . . . ; "RTN","DGPFRAL1",106,0) . . . ; get patient demographics "RTN","DGPFRAL1",107,0) . . . K DGPAT "RTN","DGPFRAL1",108,0) . . . Q:'$$GETPAT^DGPFUT2(DGDFN,.DGPAT) "RTN","DGPFRAL1",109,0) . . . ; "RTN","DGPFRAL1",110,0) . . . ; call to build temp global "RTN","DGPFRAL1",111,0) . . . D BLDTMP(.DGPFA,.DGPAT,.DGHIENS,DGCATG,DGLIST) "RTN","DGPFRAL1",112,0) ; "RTN","DGPFRAL1",113,0) Q "RTN","DGPFRAL1",114,0) ; "RTN","DGPFRAL1",115,0) BLDTMP(DGPFA,DGPAT,DGHIENS,DGCATG,DGLIST) ; list global builder "RTN","DGPFRAL1",116,0) ; Input: "RTN","DGPFRAL1",117,0) ; DGPFA - array of assignment record data "RTN","DGPFRAL1",118,0) ; DGPAT - array of patient demographics "RTN","DGPFRAL1",119,0) ; DGHIENS - array of history action IEN's sorted by d/t "RTN","DGPFRAL1",120,0) ; DGCATG - category of flag 1=National, 2=Local "RTN","DGPFRAL1",121,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",122,0) ; "RTN","DGPFRAL1",123,0) ; Output: "RTN","DGPFRAL1",124,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRAL1",125,0) ; "RTN","DGPFRAL1",126,0) N DGACTDT ;initial entry date "RTN","DGPFRAL1",127,0) N DGFGNM ;flag name "RTN","DGPFRAL1",128,0) N DGHIEN ;assignment ien "RTN","DGPFRAL1",129,0) N DGLINE ;report detail line "RTN","DGPFRAL1",130,0) N DGLNCNT ;unique subscript counter "RTN","DGPFRAL1",131,0) N DGPDFN ;pointer to patient "RTN","DGPFRAL1",132,0) N DGPFAH ;assignment history record data "RTN","DGPFRAL1",133,0) N DGPNM ;patient name "RTN","DGPFRAL1",134,0) N DGFLAG ;change of assignment flag "RTN","DGPFRAL1",135,0) ; "RTN","DGPFRAL1",136,0) ; Check to see if this was a change of assignment "RTN","DGPFRAL1",137,0) S DGFLAG=0 "RTN","DGPFRAL1",138,0) N DGI S DGI=0 "RTN","DGPFRAL1",139,0) D FLGXFER "RTN","DGPFRAL1",140,0) ; "RTN","DGPFRAL1",141,0) ; loop all assignment history ien's "RTN","DGPFRAL1",142,0) S DGHIEN="",DGLNCNT=0 "RTN","DGPFRAL1",143,0) F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D Q:DGQ "RTN","DGPFRAL1",144,0) . S DGI=DGI+1 I '(DGI#200) D CHK Q:DGQ "RTN","DGPFRAL1",145,0) . ; get assignment history record "RTN","DGPFRAL1",146,0) . K DGPFAH "RTN","DGPFRAL1",147,0) . Q:'$$GETHIST^DGPFAAH(DGHIENS(DGHIEN),.DGPFAH) "RTN","DGPFRAL1",148,0) . Q:+$G(DGPFAH("TIULINK")) ; progress note pointer "RTN","DGPFRAL1",149,0) . Q:+$G(DGPFAH("ACTION"))=5 ; no ENTERED IN ERROR action "RTN","DGPFRAL1",150,0) . S DGACTDT=$$FMTE^XLFDT(+DGPFAH("ASSIGNDT")\1,"2Z") "RTN","DGPFRAL1",151,0) . I DGFLAG I +DGPFAH("ASSIGNDT")'>DGFLAG Q ; if < assignment chg "RTN","DGPFRAL1",152,0) . Q:'$$LOCAL() ; check local/not local DG*5.3*960 "RTN","DGPFRAL1",153,0) . S DGPNM=DGPAT("NAME") "RTN","DGPFRAL1",154,0) . S:DGPNM']"" DGPNM="MISSING PATIENT NAME" "RTN","DGPFRAL1",155,0) . S DGPDFN=$P(DGPFA("DFN"),U) "RTN","DGPFRAL1",156,0) . S DGFGNM=$P(DGPFA("FLAG"),U,2) "RTN","DGPFRAL1",157,0) . S:DGFGNM']"" DGFGNM="MISSING FLAG NAME" "RTN","DGPFRAL1",158,0) . S DGLINE=$E(DGPNM)_$E(DGPAT("SSN"),6,10)_U_$E(DGFGNM,1,17) "RTN","DGPFRAL1",159,0) . S DGLINE=DGLINE_U_$P(DGPFAH("ACTION"),U,2)_U_DGACTDT "RTN","DGPFRAL1",160,0) . S DGLNCNT=DGLNCNT+1 "RTN","DGPFRAL1",161,0) . S @DGLIST@(DGCATG,DGFGNM,DGPNM,DGPDFN,DGLNCNT)=DGLINE "RTN","DGPFRAL1",162,0) ; "RTN","DGPFRAL1",163,0) Q "RTN","DGPFRAL1",164,0) ; "RTN","DGPFRAL1",165,0) PRINT(DGSORT,DGLIST) ;output report "RTN","DGPFRAL1",166,0) ; Input: "RTN","DGPFRAL1",167,0) ; DGSORT - array of user selected report parameters "RTN","DGPFRAL1",168,0) ; DGLIST - temp global name used for report list "RTN","DGPFRAL1",169,0) ; "RTN","DGPFRAL1",170,0) ; Output: Formatted report to user selected device "RTN","DGPFRAL1",171,0) ; "RTN","DGPFRAL1",172,0) N CAT ; flag category "RTN","DGPFRAL1",173,0) N OCAT ; previous flag category "RTN","DGPFRAL1",174,0) N DFN ; ien of patient "RTN","DGPFRAL1",175,0) N ODFN ; previous DFN "RTN","DGPFRAL1",176,0) N FLAG ; flag name "RTN","DGPFRAL1",177,0) N NAM ; patient name "RTN","DGPFRAL1",178,0) N OFLAG ; previoous flag name "RTN","DGPFRAL1",179,0) N PAGE ; page counter "RTN","DGPFRAL1",180,0) N REF ; $query incrementing variable "RTN","DGPFRAL1",181,0) N STR ; string of detail line to display "RTN","DGPFRAL1",182,0) N I,X,Y,STOP,TOTAL "RTN","DGPFRAL1",183,0) ; "RTN","DGPFRAL1",184,0) S (OCAT,ODFN,OFLAG)="" "RTN","DGPFRAL1",185,0) S REF=DGLIST "RTN","DGPFRAL1",186,0) S STOP=$TR(REF,")",",") "RTN","DGPFRAL1",187,0) S (TOTAL,TOTAL(1),TOTAL(2))=0 "RTN","DGPFRAL1",188,0) S PAGE=0 "RTN","DGPFRAL1",189,0) ; "RTN","DGPFRAL1",190,0) I $O(@DGLIST@(""))="" D Q "RTN","DGPFRAL1",191,0) . D HEAD "RTN","DGPFRAL1",192,0) . W !!," >>> No Record Flag Assignments were found using the report criteria.",! "RTN","DGPFRAL1",193,0) . Q "RTN","DGPFRAL1",194,0) ; "RTN","DGPFRAL1",195,0) F I=1:1 S REF=$Q(@REF) Q:REF="" Q:REF'[STOP D Q:DGQ "RTN","DGPFRAL1",196,0) . N NL S NL=1 ; flag to indicate a new line is needed "RTN","DGPFRAL1",197,0) . S STR=@REF "RTN","DGPFRAL1",198,0) . S CAT=$QS(REF,3),FLAG=$QS(REF,4),NAM=$QS(REF,5),DFN=$QS(REF,6) "RTN","DGPFRAL1",199,0) . ; for each flag/pat combination, write flag and pat only once "RTN","DGPFRAL1",200,0) . ; however, repeat name/flag at beginning of new page "RTN","DGPFRAL1",201,0) . ; do header for each category change "RTN","DGPFRAL1",202,0) . I CAT'=OCAT,+OCAT D SUBTOT Q:DGQ "RTN","DGPFRAL1",203,0) . I CAT'=OCAT D HEAD S OCAT=CAT "RTN","DGPFRAL1",204,0) . I $Y>(IOSL-4) D PAUSE Q:DGQ D HEAD S ODFN="" "RTN","DGPFRAL1",205,0) . I DFN'=ODFN D "RTN","DGPFRAL1",206,0) . . W !,$E(NAM,1,18),?20,$P(STR,U),?32,$E($P(STR,U,2),1,17) "RTN","DGPFRAL1",207,0) . . S ODFN=DFN,OFLAG=FLAG,NL=0 "RTN","DGPFRAL1",208,0) . . Q "RTN","DGPFRAL1",209,0) . ; - write new flag name "RTN","DGPFRAL1",210,0) . I OFLAG'=FLAG S OFLAG=FLAG W !?32,$E($P(STR,U,2),1,17),NL=0 "RTN","DGPFRAL1",211,0) . ; - write action detail "RTN","DGPFRAL1",212,0) . W:NL ! W ?51,$E($P(STR,U,3),1,16),?69,$P(STR,U,4) "RTN","DGPFRAL1",213,0) . S TOTAL(CAT)=TOTAL(CAT)+1 "RTN","DGPFRAL1",214,0) . Q "RTN","DGPFRAL1",215,0) ; "RTN","DGPFRAL1",216,0) ; Last category subtotals did not print "RTN","DGPFRAL1",217,0) S OCAT=CAT D SUBTOT "RTN","DGPFRAL1",218,0) ; "RTN","DGPFRAL1",219,0) D CHK "RTN","DGPFRAL1",220,0) ; Print totals if both cat I & II selected "RTN","DGPFRAL1",221,0) I 'DGQ,+DGSORT("DGCAT")=3 D "RTN","DGPFRAL1",222,0) . I 'TRM,(IOSL-$Y)<10 D HEAD "RTN","DGPFRAL1",223,0) . W !!,"REPORT SUMMARY:",!,"---------------" "RTN","DGPFRAL1",224,0) . W !,"Total Actions not Linked for Category I:",?48,$J(TOTAL(1),7) "RTN","DGPFRAL1",225,0) . W !,"Total Actions not Linked for Category II:",?48,$J(TOTAL(2),7) "RTN","DGPFRAL1",226,0) . W !?48,"-------" "RTN","DGPFRAL1",227,0) . S X=TOTAL(1)+TOTAL(2) "RTN","DGPFRAL1",228,0) . W !,"Total Actions not Linked for Category I & II:",?48,$J(X,7) "RTN","DGPFRAL1",229,0) . Q "RTN","DGPFRAL1",230,0) W !!,"" "RTN","DGPFRAL1",231,0) Q "RTN","DGPFRAL1",232,0) ; "RTN","DGPFRAL1",233,0) ;----------------------- PRIVATE SUBROUTINES ----------------------- "RTN","DGPFRAL1",234,0) ; "RTN","DGPFRAL1",235,0) CHK ; "RTN","DGPFRAL1",236,0) ; Check is Taskman request to stop "RTN","DGPFRAL1",237,0) I 'DGQ,$D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQ)=1 "RTN","DGPFRAL1",238,0) I DGQ,$D(ZTQUEUED) W !!,"REPORT STOPPED AT USER REQUEST",! "RTN","DGPFRAL1",239,0) Q "RTN","DGPFRAL1",240,0) ; "RTN","DGPFRAL1",241,0) ENTINERR(DGIEN) ; "RTN","DGPFRAL1",242,0) ; Is last action ENTERED IN ERROR "RTN","DGPFRAL1",243,0) ; Input: "RTN","DGPFRAL1",244,0) ; DGIEN - (required) Pointer to PRF ASSIGNMENT (#26.13) file "RTN","DGPFRAL1",245,0) ; "RTN","DGPFRAL1",246,0) ; Output: "RTN","DGPFRAL1",247,0) ; Function Value - Return 1 on success, 0 on failure "RTN","DGPFRAL1",248,0) ; "RTN","DGPFRAL1",249,0) N DGPFAH "RTN","DGPFRAL1",250,0) I $$GETHIST^DGPFAAH($$GETLAST^DGPFAAH(DGIEN),.DGPFAH) "RTN","DGPFRAL1",251,0) Q +$G(DGPFAH("ACTION"))=5 "RTN","DGPFRAL1",252,0) ; "RTN","DGPFRAL1",253,0) FLAGNM(FLG) ; "RTN","DGPFRAL1",254,0) ; Is flag = selected flag; DG*5.3*960 "RTN","DGPFRAL1",255,0) ; "DGFLG": variable_pointer for flag, else "" "RTN","DGPFRAL1",256,0) N SORT S SORT=$P($G(DGSORT("DGFLG")),U,3) "RTN","DGPFRAL1",257,0) Q $S('SORT:1,1:SORT=FLG) "RTN","DGPFRAL1",258,0) ; "RTN","DGPFRAL1",259,0) FLGXFER ; "RTN","DGPFRAL1",260,0) ; If flag transferred and prior to assignment change date "RTN","DGPFRAL1",261,0) ; then do not rpt missing TIU link "RTN","DGPFRAL1",262,0) N X,DGHIEN,DGHACT "RTN","DGPFRAL1",263,0) Q:$P($G(DGPFA("ORIGSITE")),U)=$P($G(DGPFA("OWNER")),U) "RTN","DGPFRAL1",264,0) S X="Change of flag assignment ownership." "RTN","DGPFRAL1",265,0) S DGHIEN="" "RTN","DGPFRAL1",266,0) F S DGHIEN=$O(DGHIENS(DGHIEN)) Q:DGHIEN="" D "RTN","DGPFRAL1",267,0) . S DGHACT=DGHIENS(DGHIEN) "RTN","DGPFRAL1",268,0) . I $G(^DGPF(26.14,DGHACT,1,1,0))[X S DGFLAG=$P(DGHIEN,U) "RTN","DGPFRAL1",269,0) Q "RTN","DGPFRAL1",270,0) ; "RTN","DGPFRAL1",271,0) HEAD ; "RTN","DGPFRAL1",272,0) ; Print/Display page header "RTN","DGPFRAL1",273,0) N X D CHK Q:DGQ "RTN","DGPFRAL1",274,0) I TRM!('TRM&PAGE) W @IOF "RTN","DGPFRAL1",275,0) S PAGE=PAGE+1 "RTN","DGPFRAL1",276,0) S X=$S('$D(CAT):"",+CAT=1:"I (National)",1:"II (Local)") "RTN","DGPFRAL1",277,0) F I=1:1:3 W !,HD(I) W:I=2 $J(PAGE,5) "RTN","DGPFRAL1",278,0) I PAGE<2 F I=1:1:4 W !,HD(1,I) "RTN","DGPFRAL1",279,0) I $D(CAT),CAT'=OCAT F I=1:1:4 W !,HD(2,I) W:I=1 X "RTN","DGPFRAL1",280,0) Q "RTN","DGPFRAL1",281,0) ; "RTN","DGPFRAL1",282,0) INIT ; initial certain local variables "RTN","DGPFRAL1",283,0) N X,BEG,END,FLG,PRT,SP "RTN","DGPFRAL1",284,0) S $P(SP," ",80)="" "RTN","DGPFRAL1",285,0) S TRM=($E(IOST)="C") I TRM D WAIT^DICD "RTN","DGPFRAL1",286,0) S DGLIST=$NA(^TMP("DGPFRAL1",$J)) ;temp global for report "RTN","DGPFRAL1",287,0) K @DGLIST "RTN","DGPFRAL1",288,0) S DGQ=0 "RTN","DGPFRAL1",289,0) ; "RTN","DGPFRAL1",290,0) ; header display for all pages "RTN","DGPFRAL1",291,0) S HD(1)=$E(SP,1,24)_"Patient Record Flags" "RTN","DGPFRAL1",292,0) S X="Assignment Action Not Linked To A Progress Note Report" "RTN","DGPFRAL1",293,0) S $E(X,68)="Page: " "RTN","DGPFRAL1",294,0) S HD(2)=X "RTN","DGPFRAL1",295,0) S $P(HD(3),"-",80)="" "RTN","DGPFRAL1",296,0) ; "RTN","DGPFRAL1",297,0) S BEG=$$FMTE^XLFDT(DGSORT("DGBEG"),"5Z") "RTN","DGPFRAL1",298,0) S END=$$FMTE^XLFDT(DGSORT("DGEND"),"5Z") "RTN","DGPFRAL1",299,0) S PRT=$$FMTE^XLFDT($$NOW^XLFDT,"MP") "RTN","DGPFRAL1",300,0) S FLG=$P(DGSORT("DGFLG"),U,2) S:FLG="" FLG="All flags" "RTN","DGPFRAL1",301,0) ; "RTN","DGPFRAL1",302,0) ; display in header for first page only "RTN","DGPFRAL1",303,0) S HD(1,1)="REPORT TYPE: "_$P(DGSORT("DGCAT"),U,2) "RTN","DGPFRAL1",304,0) S $E(HD(1,1),47)="STATUS: "_$P(DGSORT("DGSTA"),U,2) "RTN","DGPFRAL1",305,0) S HD(1,2)=" FLAG: "_FLG "RTN","DGPFRAL1",306,0) S $E(HD(1,2),44)="ACTION BY: "_$P(DGSORT("DGFAC"),U,2) "RTN","DGPFRAL1",307,0) S HD(1,3)=" DATE RANGE: "_BEG_" To "_END "RTN","DGPFRAL1",308,0) S $E(HD(1,3),46)="PRINTED: "_PRT "RTN","DGPFRAL1",309,0) S HD(1,4)=HD(3) "RTN","DGPFRAL1",310,0) ; "RTN","DGPFRAL1",311,0) ; sub-header display / column header display "RTN","DGPFRAL1",312,0) S HD(2,1)=" CATEGORY: " "RTN","DGPFRAL1",313,0) S HD(2,2)="" "RTN","DGPFRAL1",314,0) S HD(2,3)="PATIENT SSN FLAG NAME ACTION ACTION DATE" "RTN","DGPFRAL1",315,0) S HD(2,4)="------------------ ---------- ----------------- ---------------- -----------" "RTN","DGPFRAL1",316,0) Q "RTN","DGPFRAL1",317,0) ; "RTN","DGPFRAL1",318,0) LOCAL() ; "RTN","DGPFRAL1",319,0) ; Filter is history created locally or not; DG*5.3*960 "RTN","DGPFRAL1",320,0) ; expects .DGPFAH; "DGFAC": 1:local;2:other;3:both "RTN","DGPFRAL1",321,0) N X,LOC,SORT,TMP "RTN","DGPFRAL1",322,0) S SORT=+$G(DGSORT("DGFAC")) I SORT=3 Q 1 "RTN","DGPFRAL1",323,0) F X="APPRVBY","ENTERBY","ORIGFAC" S TMP(X)=$G(DGPFAH(X)) "RTN","DGPFRAL1",324,0) S LOC=$$LOC^DGPFUT63(.TMP) "RTN","DGPFRAL1",325,0) ; filter for locally created history records only "RTN","DGPFRAL1",326,0) I SORT=1 Q LOC=1 "RTN","DGPFRAL1",327,0) ; filter for history records not created locally "RTN","DGPFRAL1",328,0) I SORT=2 Q LOC=0 "RTN","DGPFRAL1",329,0) Q 0 "RTN","DGPFRAL1",330,0) ; "RTN","DGPFRAL1",331,0) PAUSE ; pause screen display "RTN","DGPFRAL1",332,0) ; if DGQ=1 exit printing "RTN","DGPFRAL1",333,0) I TRM,PAGE,$$E^DGPFUT7<1 S DGQ=1 "RTN","DGPFRAL1",334,0) Q "RTN","DGPFRAL1",335,0) ; "RTN","DGPFRAL1",336,0) STATUS(STAT) ;filter on active/inactive; DG*5.3*960 "RTN","DGPFRAL1",337,0) ; "DGSTA": 1:inactive;2:active;3:both "RTN","DGPFRAL1",338,0) ; STAT : 0:inactive;1:active "RTN","DGPFRAL1",339,0) N SORT S SORT=$G(DGSORT("DGSTA"))-1 S:SORT<0 SORT=2 "RTN","DGPFRAL1",340,0) Q $S(SORT>1:1,SORT=1:STAT=1,1:STAT=0) "RTN","DGPFRAL1",341,0) ; "RTN","DGPFRAL1",342,0) SUBTOT ; "RTN","DGPFRAL1",343,0) ; Print subtotals for category at end of that category listing "RTN","DGPFRAL1",344,0) ; Expects CAT and OCAT "RTN","DGPFRAL1",345,0) W !!,"Total Actions not Linked for Category " "RTN","DGPFRAL1",346,0) W $S(OCAT=1:"I",1:"II")_": "_(+TOTAL(OCAT)) "RTN","DGPFRAL1",347,0) D:+DGSORT("DGCAT")=3 PAUSE "RTN","DGPFRAL1",348,0) S ODFN="" "RTN","DGPFRAL1",349,0) Q "RTN","DGPFRFA") 0^4^B5793844^B17792002 "RTN","DGPFRFA",1,0) DGPFRFA ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT ; 7/26/05 3:41pm "RTN","DGPFRFA",2,0) ;;5.3;Registration;**425,555,554,960**;Aug 13, 1993;Build 22 "RTN","DGPFRFA",3,0) ; Last Edited: SHRPE/sgm - Jul 9, 2018 13:33 "RTN","DGPFRFA",4,0) ; "RTN","DGPFRFA",5,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFRFA",6,0) ;----- ---- ---------------------------------------- "RTN","DGPFRFA",7,0) ; 1519 Sup EN^XUTMDEVQ "RTN","DGPFRFA",8,0) ; 2055 Sup $$EXTERNAL "RTN","DGPFRFA",9,0) ;10086 Sup HOME^%ZIS "RTN","DGPFRFA",10,0) ; "RTN","DGPFRFA",11,0) ;This routine will be used for selecting sort parameters to produce "RTN","DGPFRFA",12,0) ; the FLAG ASSIGNMENT REPORT for Patient Record Flags. "RTN","DGPFRFA",13,0) ; "RTN","DGPFRFA",14,0) ; DGSORT(label) = value will store the user selected options "RTN","DGPFRFA",15,0) ; DGSORT("DGCAT") = 1^Category I (National) "RTN","DGPFRFA",16,0) ; 2^Category II (Local) "RTN","DGPFRFA",17,0) ; 3^Category I & II "RTN","DGPFRFA",18,0) ; DGSORT("DGOWN") = 1^Local Facility "RTN","DGPFRFA",19,0) ; 2^Other Facilities "RTN","DGPFRFA",20,0) ; 3^All Facilities "RTN","DGPFRFA",21,0) ; DGSORT("DGSTAT") = 1^Active "RTN","DGPFRFA",22,0) ; 2^Inactive "RTN","DGPFRFA",23,0) ; DGSORT("DGFLAG") = A^All Flags "RTN","DGPFRFA",24,0) ; variable_pointer^flag name "RTN","DGPFRFA",25,0) ; e.g., 1;DGPF(26.15, "RTN","DGPFRFA",26,0) ; DGSORT("DGBEG") = start date FM format "RTN","DGPFRFA",27,0) ; DGSORT("DGEND") = end date FM format "RTN","DGPFRFA",28,0) ; "RTN","DGPFRFA",29,0) ;-- no direct entry "RTN","DGPFRFA",30,0) QUIT "RTN","DGPFRFA",31,0) ; "RTN","DGPFRFA",32,0) EN ;Entry point "RTN","DGPFRFA",33,0) ;-- user prompts for report selection sorts "RTN","DGPFRFA",34,0) ; Input: none "RTN","DGPFRFA",35,0) ; Output: Report generated using user selected parameters "RTN","DGPFRFA",36,0) ; "RTN","DGPFRFA",37,0) N X,Y,DGCAT,DGFIRST,DGSORT,ZTSAVE "RTN","DGPFRFA",38,0) ; "RTN","DGPFRFA",39,0) ;check for database "RTN","DGPFRFA",40,0) S DGFIRST=$$DATA^DGPFUT7 I DGFIRST<1 Q "RTN","DGPFRFA",41,0) ; "RTN","DGPFRFA",42,0) ;-- prompt for selection of a flag category (I, II, Both) "RTN","DGPFRFA",43,0) S DGCAT=$$CAT^DGPFUT7 Q:DGCAT<1 S DGSORT("DGCAT")=DGCAT "RTN","DGPFRFA",44,0) ; "RTN","DGPFRFA",45,0) ;-- prompt for selection of a single flag or all flags "RTN","DGPFRFA",46,0) ; list (A)ll flags if user selects Both Category's "RTN","DGPFRFA",47,0) S DGSORT("DGFLAG")="A^All Flags" "RTN","DGPFRFA",48,0) I DGCAT<3 D I X=-1 Q "RTN","DGPFRFA",49,0) . ; ask for all or single flag "RTN","DGPFRFA",50,0) . S X=$$FLAG^DGPFUT7 I X=-1 Q "RTN","DGPFRFA",51,0) . S DGSORT("DGFLAG")=X I $E(X)="A" Q "RTN","DGPFRFA",52,0) . ; ask for single flag name "RTN","DGPFRFA",53,0) . F D Q:+X "RTN","DGPFRFA",54,0) . . N CAT S CAT=$S(+DGCAT=1:"I",1:"II") "RTN","DGPFRFA",55,0) . . S X=$$ONEFLAG^DGPFUT7(CAT,1) I X=-1 Q "RTN","DGPFRFA",56,0) . . I X>0 S DGSORT("DGFLAG")=X Q "RTN","DGPFRFA",57,0) . . S X=0 W !?6,"Select another flag." "RTN","DGPFRFA",58,0) . . Q "RTN","DGPFRFA",59,0) . Q "RTN","DGPFRFA",60,0) ; "RTN","DGPFRFA",61,0) ;-- prompt for locally owned assignments or not ; DG*5.3*960 "RTN","DGPFRFA",62,0) I +DGSORT("DGCAT")=2 S DGSORT("DGOWN")="1^Local Facility" "RTN","DGPFRFA",63,0) E S X=$$OWNASGN^DGPFUT7 Q:X<1 S DGSORT("DGOWN")=X "RTN","DGPFRFA",64,0) ; "RTN","DGPFRFA",65,0) ;-- prompt for active/inactive ; DG*3.5*960 "RTN","DGPFRFA",66,0) S X=$$STATUS^DGPFUT7(0) Q:X<1 S DGSORT("DGSTAT")=X "RTN","DGPFRFA",67,0) ; "RTN","DGPFRFA",68,0) ;-- prompt for beginning date "RTN","DGPFRFA",69,0) W ! S X=$$START^DGPFUT7(DGFIRST,DT) I X<1 Q "RTN","DGPFRFA",70,0) S DGSORT("DGBEG")=X "RTN","DGPFRFA",71,0) ; "RTN","DGPFRFA",72,0) ;-- prompt for ending date "RTN","DGPFRFA",73,0) S X=$$END^DGPFUT7(DGSORT("DGBEG"),DT) I X<1 Q "RTN","DGPFRFA",74,0) S DGSORT("DGEND")=X "RTN","DGPFRFA",75,0) ; "RTN","DGPFRFA",76,0) P ;-- prompt for device "RTN","DGPFRFA",77,0) ;;WARNING: this report expects the device to support 132 column reports "RTN","DGPFRFA",78,0) W !!,$TR($T(P+1),";"," "),! "RTN","DGPFRFA",79,0) S ZTSAVE("DGSORT(")="" "RTN","DGPFRFA",80,0) D EN^XUTMDEVQ("START^DGPFRFA1","Patient Record Flag Assignment Report",.ZTSAVE) "RTN","DGPFRFA",81,0) D HOME^%ZIS "RTN","DGPFRFA",82,0) Q "RTN","DGPFRFA1") 0^5^B123710577^B41214587 "RTN","DGPFRFA1",1,0) DGPFRFA1 ;ALB/RBS - PRF FLAG ASSIGNMENT REPORT CONT. ; 1/21/04 5:14pm "RTN","DGPFRFA1",2,0) ;;5.3;Registration;**425,554,960**;Aug 13, 1993;Build 22 "RTN","DGPFRFA1",3,0) ; Last Edited: SHRPE/sgm - Jul 9, 2018 13:30 "RTN","DGPFRFA1",4,0) ; "RTN","DGPFRFA1",5,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFRFA1",6,0) ;----- ---- --------------------------------- "RTN","DGPFRFA1",7,0) ;10024 Sup WAIT^DICD "RTN","DGPFRFA1",8,0) ;10026 Sup ^DIR "RTN","DGPFRFA1",9,0) ;10086 Sup HOME^%ZIS "RTN","DGPFRFA1",10,0) ;10103 Sup ^XLFDT: $$FMDIFF, $$FMTE, $$NOW "RTN","DGPFRFA1",11,0) ;10063 Sup $$S^%ZTLOAD "RTN","DGPFRFA1",12,0) ; "RTN","DGPFRFA1",13,0) ;This routine will compile and produce the FLAG ASSIGNMENT REPORT. "RTN","DGPFRFA1",14,0) ;This routine will be used to display or print all of the patient "RTN","DGPFRFA1",15,0) ; assignments for Category I and Category II Patient Record Flags. "RTN","DGPFRFA1",16,0) ; "RTN","DGPFRFA1",17,0) ;All sort input was created in routine DGPFRFA passed by Taskman "RTN","DGPFRFA1",18,0) ; Input: The following array contains the sort var's: "RTN","DGPFRFA1",19,0) ; "RTN","DGPFRFA1",20,0) ; DGSORT(subscript)=value [see routine DGPFRFA for details] "RTN","DGPFRFA1",21,0) ; "RTN","DGPFRFA1",22,0) ; Output: A formatted report of Record Flag Assignments to patients. "RTN","DGPFRFA1",23,0) ;5/1/2018 - DG*5.3*960 - report format substantially changed "RTN","DGPFRFA1",24,0) ;- no direct entry "RTN","DGPFRFA1",25,0) QUIT "RTN","DGPFRFA1",26,0) ; "RTN","DGPFRFA1",27,0) START ; compile and print report "RTN","DGPFRFA1",28,0) N DGLIST,HDR,LINE,TRM,ZTSTOP "RTN","DGPFRFA1",29,0) N DGC,DGF,DGO,DGS,DGBEG,DGEND "RTN","DGPFRFA1",30,0) S ZTSTOP=0 "RTN","DGPFRFA1",31,0) K ^TMP("DGPFRFA1",$J) "RTN","DGPFRFA1",32,0) S DGLIST=$NA(^TMP("DGPFRFA1",$J)) "RTN","DGPFRFA1",33,0) S $P(LINE,"-",104)="" "RTN","DGPFRFA1",34,0) ; "RTN","DGPFRFA1",35,0) D ; convert some DGSORT() to convenient local variables "RTN","DGPFRFA1",36,0) . ; DGC, DGF, DGO, DGS "RTN","DGPFRFA1",37,0) . ; Category, Flag, Ownership, Status "RTN","DGPFRFA1",38,0) . N X "RTN","DGPFRFA1",39,0) . S (DGBEG,DGC,DGEND,DGF,DGO,DGS)="" "RTN","DGPFRFA1",40,0) . ; convert category to 0 or file# of variable pointer "RTN","DGPFRFA1",41,0) . S X=+DGSORT("DGCAT") S DGC=$S(X=3:0,X=1:26.15,1:26.11) "RTN","DGPFRFA1",42,0) . ; "RTN","DGPFRFA1",43,0) . ; convert ownership to 1:Local; 2:Other; 0:Both "RTN","DGPFRFA1",44,0) . S X=+DGSORT("DGOWN") S DGO=$S(X=3:0,1:X) "RTN","DGPFRFA1",45,0) . ; "RTN","DGPFRFA1",46,0) . ; status 0:Inactive 1:Active "RTN","DGPFRFA1",47,0) . ; reset so coordinated with ^DD(26.13) "RTN","DGPFRFA1",48,0) . S DGS=(+DGSORT("DGSTAT")=1) "RTN","DGPFRFA1",49,0) . ; "RTN","DGPFRFA1",50,0) . ; DGF = A:all or variable pointer syntax for single flag "RTN","DGPFRFA1",51,0) . S DGF=$P(DGSORT("DGFLAG"),U) "RTN","DGPFRFA1",52,0) . S DGBEG=(DGSORT("DGBEG")\1) "RTN","DGPFRFA1",53,0) . S DGEND=(DGSORT("DGEND")\1) "RTN","DGPFRFA1",54,0) . Q "RTN","DGPFRFA1",55,0) ; "RTN","DGPFRFA1",56,0) S TRM=($E(IOST)="C") I TRM D WAIT^DICD "RTN","DGPFRFA1",57,0) ; START module initialized 6 local variables used by next code "RTN","DGPFRFA1",58,0) D A1 ; find data to print "RTN","DGPFRFA1",59,0) D HDR ; build HDR() array "RTN","DGPFRFA1",60,0) D PRT "RTN","DGPFRFA1",61,0) ; "RTN","DGPFRFA1",62,0) EXIT ; "RTN","DGPFRFA1",63,0) K ^TMP("DGPFRFA1",$J) "RTN","DGPFRFA1",64,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DGPFRFA1",65,0) I TRM D ^%ZISC "RTN","DGPFRFA1",66,0) Q "RTN","DGPFRFA1",67,0) ; "RTN","DGPFRFA1",68,0) ;----------------------- PRIVATE SUBROUTINES ----------------------- "RTN","DGPFRFA1",69,0) A1 ; "RTN","DGPFRFA1",70,0) ; Find records using sort var's to build list "RTN","DGPFRFA1",71,0) ; Output: "RTN","DGPFRFA1",72,0) ; ^TMP("DGPFRFA1",$J) - temp global containing report output "RTN","DGPFRFA1",73,0) ; "RTN","DGPFRFA1",74,0) N DGQ,DGSUB "RTN","DGPFRFA1",75,0) S DGQ=0 "RTN","DGPFRFA1",76,0) ; DGF="A" for all flags or is single variable pointer syntax "RTN","DGPFRFA1",77,0) ; ^DGPF(26.13,"AFLAG",DGSUB,dfn,ien) "RTN","DGPFRFA1",78,0) I +DGF,'$D(^DGPF(26.13,"AFLAG",DGF)) Q "RTN","DGPFRFA1",79,0) ; "RTN","DGPFRFA1",80,0) S DGSUB=0 I +DGF S DGSUB=$O(^DGPF(26.13,"AFLAG",DGF),-1) "RTN","DGPFRFA1",81,0) F S DGSUB=$O(^DGPF(26.13,"AFLAG",DGSUB)) Q:DGSUB="" D Q:DGQ "RTN","DGPFRFA1",82,0) . I +DGF,DGSUB'=DGF S DGQ=1 Q ; single flag "RTN","DGPFRFA1",83,0) . I +DGC,DGSUB'[DGC Q ; single flag category "RTN","DGPFRFA1",84,0) . ; "RTN","DGPFRFA1",85,0) . N DGCNT,DGDFN,DGDFNLST "RTN","DGPFRFA1",86,0) . ; now get all patients with DGSUB flag assignment "RTN","DGPFRFA1",87,0) . ; dgdfnlst(dfn)=ien_file_26.13 "RTN","DGPFRFA1",88,0) . Q:'$$ASGNCNT^DGPFLF6(DGSUB,.DGDFNLST) "RTN","DGPFRFA1",89,0) . S DGDFN=0 F S DGDFN=$O(DGDFNLST(DGDFN)) Q:DGDFN="" D "RTN","DGPFRFA1",90,0) . . N X,Y,DGIEN,DGPFA,OWN,STAT "RTN","DGPFRFA1",91,0) . . S DGIEN=DGDFNLST(DGDFN) Q:DGIEN="" "RTN","DGPFRFA1",92,0) . . Q:'$$GETASGN^DGPFAA(DGIEN,.DGPFA) "RTN","DGPFRFA1",93,0) . . ; filter, get history, save computed value in DGPFA() "RTN","DGPFRFA1",94,0) . . I $$A11 D A12 "RTN","DGPFRFA1",95,0) . . Q "RTN","DGPFRFA1",96,0) . Q "RTN","DGPFRFA1",97,0) Q "RTN","DGPFRFA1",98,0) ; "RTN","DGPFRFA1",99,0) A11() ; apply filters "RTN","DGPFRFA1",100,0) ; 1. Get all History records of certain ACTION types: "RTN","DGPFRFA1",101,0) ; 2: Action types: New, Inactivate, Reactivate, Enter in Error "RTN","DGPFRFA1",102,0) ; 3. Action DATE must be within date range "RTN","DGPFRFA1",103,0) ; "RTN","DGPFRFA1",104,0) N X,Y,ACT,DATE,DEACT,DGHST,IEN,LAST,NUM "RTN","DGPFRFA1",105,0) ; check STATUS "RTN","DGPFRFA1",106,0) S X=+$G(DGPFA("STATUS")) I X'=DGS Q 0 "RTN","DGPFRFA1",107,0) ; check type of owner "RTN","DGPFRFA1",108,0) S X=+$G(DGPFA("OWNER")),Y=0 I X>0 S Y=$$ISDIV^DGPFUT(X) "RTN","DGPFRFA1",109,0) I DGO>0 I '$S(DGO=2:Y<1,1:Y>0) Q 0 "RTN","DGPFRFA1",110,0) ; get all History records of the desired ACTION "RTN","DGPFRFA1",111,0) I '$$ACTFILT^DGPFAAH2("DGHST",DGIEN,"1;3;4;5",,"D") Q 0 "RTN","DGPFRFA1",112,0) ; filter records by date range and action "RTN","DGPFRFA1",113,0) ; LAST(1) = last activation action date "RTN","DGPFRFA1",114,0) ; LAST(3) = last inactivation action date "RTN","DGPFRFA1",115,0) ; LAST(2) = first inactivation action after last activation action "RTN","DGPFRFA1",116,0) ; count total number of activation events within time range "RTN","DGPFRFA1",117,0) S (LAST(1),LAST(2),LAST(3),NUM)="" "RTN","DGPFRFA1",118,0) S DATE=0 F S DATE=$O(DGHST(DATE)) Q:'DATE D "RTN","DGPFRFA1",119,0) . S Y=DATE\1 "RTN","DGPFRFA1",120,0) . I YDGEND K DGHST(DATE) S DGHST=DGHST-1 Q "RTN","DGPFRFA1",122,0) . S IEN=0 F S IEN=$O(DGHST(DATE,IEN)) Q:'IEN D "RTN","DGPFRFA1",123,0) . . S X=+$G(DGHST(DATE,IEN,"ACTION")) "RTN","DGPFRFA1",124,0) . . I "^1^3^4^5^"'[(U_X_U) Q "RTN","DGPFRFA1",125,0) . . S Y=DATE\1 "RTN","DGPFRFA1",126,0) . . I (X=1)!(X=4) D "RTN","DGPFRFA1",127,0) . . . S NUM=NUM+1 ; number of activations "RTN","DGPFRFA1",128,0) . . . S LAST(1)=Y,LAST(2)=0 ; last activation action "RTN","DGPFRFA1",129,0) . . . Q "RTN","DGPFRFA1",130,0) . . I (X=3)!(X=5) D "RTN","DGPFRFA1",131,0) . . . S LAST(3)=Y ; last inactivation action "RTN","DGPFRFA1",132,0) . . . ; first inactivation action after last activation action "RTN","DGPFRFA1",133,0) . . . I +LAST(1),'LAST(2),Y'132 STR=$E(STR,1,132) "RTN","DGPFRFA1",220,0) Q STR "RTN","DGPFRFA1",221,0) ; "RTN","DGPFRFA1",222,0) HDR ; build header array "RTN","DGPFRFA1",223,0) ; see sample header at end of routine "RTN","DGPFRFA1",224,0) ; S $E(X,start_pos)=value "RTN","DGPFRFA1",225,0) ; Active header: 1,33,40,50,60,68,79,89,100 "RTN","DGPFRFA1",226,0) ; Inactive header: 1,33,40,50,60,58,80,92 "RTN","DGPFRFA1",227,0) N I,L,X,Y,COL,ROW "RTN","DGPFRFA1",228,0) K HDR "RTN","DGPFRFA1",229,0) S ROW=1 S HDR(ROW)="Flag Assignment Report",$E(HDR(ROW),123)="Page: " "RTN","DGPFRFA1",230,0) S ROW=2 S $P(HDR(ROW),"=",133)="" "RTN","DGPFRFA1",231,0) S ROW=3 D "RTN","DGPFRFA1",232,0) . S X="CATEGORY: " D "RTN","DGPFRFA1",233,0) . . S Y="I & II (National/Local)" "RTN","DGPFRFA1",234,0) . . I +DGC S Y=$S(DGC=26.15:"I (National)",1:"II (Local)") "RTN","DGPFRFA1",235,0) . . S HDR(ROW)=X_Y "RTN","DGPFRFA1",236,0) . . Q "RTN","DGPFRFA1",237,0) . S COL=39,$E(HDR(ROW),COL)="STATUS: "_$P(DGSORT("DGSTAT"),U,2) "RTN","DGPFRFA1",238,0) . S COL=69,X="OWNERSHIP: " D "RTN","DGPFRFA1",239,0) . . S Y=$P("All^Local^Other",U,DGO+1)_" Facilit"_$S(+DGO:"y",1:"ies") "RTN","DGPFRFA1",240,0) . . S $E(HDR(ROW),COL)=X_Y "RTN","DGPFRFA1",241,0) . . Q "RTN","DGPFRFA1",242,0) . S COL=99,X="DATE RANGE: " D "RTN","DGPFRFA1",243,0) . . S Y=$$FMTE^XLFDT(DGBEG,"2Z")_" to "_$$FMTE^XLFDT(DGEND,"2Z") "RTN","DGPFRFA1",244,0) . . S $E(HDR(ROW),COL)=X_Y "RTN","DGPFRFA1",245,0) . . Q "RTN","DGPFRFA1",246,0) . Q "RTN","DGPFRFA1",247,0) S ROW=4 D "RTN","DGPFRFA1",248,0) . I +DGF S HDR(ROW)=" FLAG: "_$P(DGSORT("DGFLAG"),U,2) "RTN","DGPFRFA1",249,0) . S COL=102,$E(HDR(ROW),COL)="PRINTED: "_$$FMTE^XLFDT(DT,"Z") "RTN","DGPFRFA1",250,0) . Q "RTN","DGPFRFA1",251,0) S ROW=5,HDR(ROW)=HDR(2) "RTN","DGPFRFA1",252,0) S ROW=6 D "RTN","DGPFRFA1",253,0) . ; inactive only report has different column headers "RTN","DGPFRFA1",254,0) . S X="" "RTN","DGPFRFA1",255,0) . S COL=40,$E(X,COL)="Orig" "RTN","DGPFRFA1",256,0) . S COL=50,$E(X,COL)="Last" "RTN","DGPFRFA1",257,0) . S COL=60,$E(X,COL)="# Days" "RTN","DGPFRFA1",258,0) . I +DGS S COL=89,$E(X,COL)="# Times" "RTN","DGPFRFA1",259,0) . I 'DGS D ; inactive report "RTN","DGPFRFA1",260,0) . . S COL=68,$E(X,COL)="Inactivate" "RTN","DGPFRFA1",261,0) . . S COL=80,$E(X,COL)="# Times" "RTN","DGPFRFA1",262,0) . . Q "RTN","DGPFRFA1",263,0) . S $E(X,132)=" " "RTN","DGPFRFA1",264,0) . S HDR(ROW)=X "RTN","DGPFRFA1",265,0) S ROW=7 D "RTN","DGPFRFA1",266,0) . S X="Patient Name" "RTN","DGPFRFA1",267,0) . S COL=33,$E(X,COL)="SSN" "RTN","DGPFRFA1",268,0) . S COL=40,$E(X,COL)="AssignDT" "RTN","DGPFRFA1",269,0) . S COL=50,$E(X,COL)="AssignDT" "RTN","DGPFRFA1",270,0) . S COL=60,$E(X,COL)="Active" "RTN","DGPFRFA1",271,0) . I +DGS D ; active only report "RTN","DGPFRFA1",272,0) . . S COL=68,$E(X,COL)="Review On" "RTN","DGPFRFA1",273,0) . . S COL=79,$E(X,COL)="Overdue?" "RTN","DGPFRFA1",274,0) . . S COL=89,$E(X,COL)="Activated" "RTN","DGPFRFA1",275,0) . . S COL=100,$E(X,COL)="Current Owning Site" "RTN","DGPFRFA1",276,0) . . Q "RTN","DGPFRFA1",277,0) . I 'DGS D ; inactive only report "RTN","DGPFRFA1",278,0) . . S COL=68,$E(X,COL)="Date" "RTN","DGPFRFA1",279,0) . . S COL=80,$E(X,COL)="Activated" "RTN","DGPFRFA1",280,0) . . S COL=92,$E(X,COL)="Current Owning Site" "RTN","DGPFRFA1",281,0) . . Q "RTN","DGPFRFA1",282,0) . S $E(X,132)=" " "RTN","DGPFRFA1",283,0) . S HDR(ROW)=X "RTN","DGPFRFA1",284,0) . Q "RTN","DGPFRFA1",285,0) S ROW=8,HDR(ROW)=$TR(HDR(2),"=","-") "RTN","DGPFRFA1",286,0) Q "RTN","DGPFRFA1",287,0) ; "RTN","DGPFRFA1",288,0) PRT ; "RTN","DGPFRFA1",289,0) ; DGLIST = ^TMP("DGPFRFA1",$J,CAT,FLAG,DGNAME,DGDFN) "RTN","DGPFRFA1",290,0) N I,X,Y,DGQ,GR,PAGE,STOP,SUBHD,TOTAL "RTN","DGPFRFA1",291,0) N CAT,CAT0,FLAG,FLAG0 "RTN","DGPFRFA1",292,0) S (DGQ,PAGE)=0 "RTN","DGPFRFA1",293,0) S SUBHD=(DGSORT("DGFLAG")<1) "RTN","DGPFRFA1",294,0) D WRHDR "RTN","DGPFRFA1",295,0) I $O(@DGLIST@(""))="" D G PRTOUT "RTN","DGPFRFA1",296,0) . S X="No Record Flag Assignments found using the report criteria." "RTN","DGPFRFA1",297,0) . W !!," >>> "_X,! "RTN","DGPFRFA1",298,0) . Q "RTN","DGPFRFA1",299,0) ; "RTN","DGPFRFA1",300,0) S GR=DGLIST,STOP=$TR(GR,")",",") "RTN","DGPFRFA1",301,0) S (CAT0,FLAG0)="" "RTN","DGPFRFA1",302,0) ; "RTN","DGPFRFA1",303,0) F S GR=$Q(@GR) Q:(GR'[STOP) D Q:DGQ "RTN","DGPFRFA1",304,0) . N X,DATA,DFN,FLAG,PNAM "RTN","DGPFRFA1",305,0) . S CAT=$QS(GR,3) "RTN","DGPFRFA1",306,0) . S FLAG=$QS(GR,4) "RTN","DGPFRFA1",307,0) . S PNAM=$QS(GR,5) "RTN","DGPFRFA1",308,0) . S DFN=$QS(GR,6) "RTN","DGPFRFA1",309,0) . S DATA=@GR "RTN","DGPFRFA1",310,0) . ; need to write subheader for next flag? "RTN","DGPFRFA1",311,0) . ; no subheader for single flag report "RTN","DGPFRFA1",312,0) . I SUBHD,CAT'=CAT0!(FLAG'=FLAG0) D WRSUBHDR Q:DGQ "RTN","DGPFRFA1",313,0) . ; update totals "RTN","DGPFRFA1",314,0) . S TOTAL(CAT)=1+$G(TOTAL(CAT)) "RTN","DGPFRFA1",315,0) . S TOTAL(CAT,FLAG)=1+$G(TOTAL(CAT,FLAG)) "RTN","DGPFRFA1",316,0) . S CAT0=CAT,FLAG0=FLAG "RTN","DGPFRFA1",317,0) . S X=$$FORMAT(DATA) D WR(X) "RTN","DGPFRFA1",318,0) . Q "RTN","DGPFRFA1",319,0) I 'DGQ D WRTOT "RTN","DGPFRFA1",320,0) ; "RTN","DGPFRFA1",321,0) PRTOUT ; "RTN","DGPFRFA1",322,0) I TRM,'DGQ W ! S X=$$E^DGPFUT7 "RTN","DGPFRFA1",323,0) Q "RTN","DGPFRFA1",324,0) ; "RTN","DGPFRFA1",325,0) WR(X) ; write out one line "RTN","DGPFRFA1",326,0) ; check for bottom of page "RTN","DGPFRFA1",327,0) ; write new header if necessary "RTN","DGPFRFA1",328,0) W !,X D WRCK() I 'DGQ,(IOSL-$Y)<4 D WRHDR "RTN","DGPFRFA1",329,0) Q "RTN","DGPFRFA1",330,0) ; "RTN","DGPFRFA1",331,0) WRCK(MIN) ; check to see if we should quit printing (set DGQ=1) "RTN","DGPFRFA1",332,0) ; Input Parameters: "RTN","DGPFRFA1",333,0) ; MIN - optional - minimal number of lines needed before end of page "RTN","DGPFRFA1",334,0) ; default to 4 "RTN","DGPFRFA1",335,0) I 'TRM Q "RTN","DGPFRFA1",336,0) S MIN=$G(MIN) S:'MIN MIN=4 S MIN=MIN+1 "RTN","DGPFRFA1",337,0) I MIN>0,(IOSL-$Y)'1 W @IOF "RTN","DGPFRFA1",348,0) W !,HDR(1)_PAGE "RTN","DGPFRFA1",349,0) I PAGE=1 F I=2:1:8 W !,HDR(I) "RTN","DGPFRFA1",350,0) I PAGE>1 F I=2,6,7,8 W !,HDR(I) "RTN","DGPFRFA1",351,0) Q "RTN","DGPFRFA1",352,0) ; "RTN","DGPFRFA1",353,0) WRSUBHDR ; write subheader of category or flag name "RTN","DGPFRFA1",354,0) D WRCK Q:DGQ "RTN","DGPFRFA1",355,0) N X,Y "RTN","DGPFRFA1",356,0) S Y=$S(CAT=1:"I (National)",1:"II (Local)") "RTN","DGPFRFA1",357,0) S X=" Flag: "_FLAG_" [Category "_Y_"]" "RTN","DGPFRFA1",358,0) W !!,X "RTN","DGPFRFA1",359,0) Q "RTN","DGPFRFA1",360,0) ; "RTN","DGPFRFA1",361,0) WRTOT ; write out totals "RTN","DGPFRFA1",362,0) N I,L,X,Y,FL,SUM "RTN","DGPFRFA1",363,0) S SUM(1)=" -----------------------------------------------" "RTN","DGPFRFA1",364,0) S SUM(2)=" SUMMARY OF TOTAL ASSIGNMENTS" "RTN","DGPFRFA1",365,0) S SUM(3)=SUM(1) "RTN","DGPFRFA1",366,0) S L=3 "RTN","DGPFRFA1",367,0) F I=1,2 I $G(TOTAL(I))>0 D "RTN","DGPFRFA1",368,0) . S X=" Category "_$P("I (National)^II (Local)",U,I) "RTN","DGPFRFA1",369,0) . S $E(X,39)=":"_$J(TOTAL(I),7) "RTN","DGPFRFA1",370,0) . S L=L+1,SUM(L)=X "RTN","DGPFRFA1",371,0) . S FL="" F S FL=$O(TOTAL(I,FL)) Q:FL="" D "RTN","DGPFRFA1",372,0) . . S X=" "_FL "RTN","DGPFRFA1",373,0) . . S $E(X,39)=":"_$J(TOTAL(I,FL),7) "RTN","DGPFRFA1",374,0) . . S L=L+1,SUM(L)=X "RTN","DGPFRFA1",375,0) . . Q "RTN","DGPFRFA1",376,0) . I I=1,$D(TOTAL(2)) S L=L+1,SUM(L)=SUM(1) "RTN","DGPFRFA1",377,0) . Q "RTN","DGPFRFA1",378,0) ; "RTN","DGPFRFA1",379,0) ; print summary on one page if possible "RTN","DGPFRFA1",380,0) I (IOSL-$Y-L)<0 D WRHDR Q:DGQ "RTN","DGPFRFA1",381,0) W ! F I=1:1:L D:(IOSL-$Y-(L-I))<0 WRHDR Q:DGQ W !,SUM(I) "RTN","DGPFRFA1",382,0) Q "RTN","DGPFRFA1",383,0) ; "RTN","DGPFRFA1",384,0) WRX ; press [ENTER] to continue "RTN","DGPFRFA1",385,0) Q:'TRM "RTN","DGPFRFA1",386,0) N L,X,Y,DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","DGPFRFA1",387,0) W ! S DIR(0)="E" D ^DIR S:$D(DTOUT)!$D(DUOUT) DGQ=1 "RTN","DGPFRFA1",388,0) Q "RTN","DGPFRFA1",389,0) ; "RTN","DGPFRFA1",390,0) WR2 ; write subtotals for flag "RTN","DGPFRFA1",391,0) Q "RTN","DGPFRFA1",392,0) I DGQ Q "RTN","DGPFRFA1",393,0) N X,Y "RTN","DGPFRFA1",394,0) S X=" Total Assignments for flag "_FLAG0_" [Category " "RTN","DGPFRFA1",395,0) S Y=$S(CAT0=1:"I (National)",1:"II (Local)") "RTN","DGPFRFA1",396,0) S X=X_Y_"]: "_(+$G(TOTAL(CAT0,FLAG0))) "RTN","DGPFRFA1",397,0) S Y=" "_$TR($E(LINE,1,$L(X)-5),"-","=") "RTN","DGPFRFA1",398,0) ; do not allow subtotals to print on 2 pages "RTN","DGPFRFA1",399,0) I (IOSL-$Y)<4 D WR() "RTN","DGPFRFA1",400,0) I 'DGQ W !!,X,!,Y,! "RTN","DGPFRFA1",401,0) Q "RTN","DGPFRFA1",402,0) ; "RTN","DGPFRFA1",403,0) ; Sample Header "RTN","DGPFRFA1",404,0) ; 1 2 3 4 5 6 7 8 9 0 1 2 3 "RTN","DGPFRFA1",405,0) ;123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012 "RTN","DGPFRFA1",406,0) ;Flag Assignment Report Page: 1 "RTN","DGPFRFA1",407,0) ;==================================================================================================================================== "RTN","DGPFRFA1",408,0) ;CATEGORY: I & II (National/Local) STATUS: Inactive OWNERSHIP: All Facilities DATE RANGE: 07/07/15 to 06/26/18 "RTN","DGPFRFA1",409,0) ; PRINTED: Jun 26, 2018 "RTN","DGPFRFA1",410,0) ;==================================================================================================================================== "RTN","DGPFRFA1",411,0) ; Orig Activated Days # Times "RTN","DGPFRFA1",412,0) ;Patient Name SSN AssignDT On Active Review On Overdue? Activated Current Owning Site "RTN","DGPFRFA1",413,0) ;------------------------------------------------------------------------------------------------------------------------------------ "RTN","DGPFRFA1",414,0) ; "RTN","DGPFRFA1",415,0) ; Flag: HIGH RISK FOR SUICIDE [Category I (National)] "RTN","DGPFUT63") 0^3^B562903^n/a "RTN","DGPFUT63",1,0) DGPFUT63 ;SHRPE/SGM - PRF UTILITIES FOR DBRS# ; Apr 3, 2018 14:18 "RTN","DGPFUT63",2,0) ;;5.3;Registration;**960**;Aug 13, 1993;Build 22 "RTN","DGPFUT63",3,0) ; Last Edited: SHRPE/sgm - May 24, 2018 10:42 "RTN","DGPFUT63",4,0) ; "RTN","DGPFUT63",5,0) ; No routines should invoked this routine directly. See DGPFUT6 "RTN","DGPFUT63",6,0) ; This routine will be called directly by the following routines "RTN","DGPFUT63",7,0) ; as part of patch 960. Once patch DG*5.3*951 is released the "RTN","DGPFUT63",8,0) ; routines listed should be converted to calling the API in the "RTN","DGPFUT63",9,0) ; DGPFUT6 routine. "RTN","DGPFUT63",10,0) ; DGPFRAL1 := LOCAL+5 S LOC=$$LOC^DGPFUT63(.TMP) "RTN","DGPFUT63",11,0) ; "RTN","DGPFUT63",12,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFUT63",13,0) ;----- ---- ----------------------------- "RTN","DGPFUT63",14,0) ; "RTN","DGPFUT63",15,0) Q "RTN","DGPFUT63",16,0) ; "RTN","DGPFUT63",17,0) LOC(DGIN) ; BOOLEAN "RTN","DGPFUT63",18,0) ; Determine if History record was created locally or at another VAMC "RTN","DGPFUT63",19,0) ; May or may not have DG*5.3*951 "RTN","DGPFUT63",20,0) ; INPUT: .DGIN - required - a copy of DGPFAH() "RTN","DGPFUT63",21,0) ; INST - optional - pointer to file 4 "RTN","DGPFUT63",22,0) ; RETURN: 1 if History created at this facility "RTN","DGPFUT63",23,0) ; 0 if History created at other facility "RTN","DGPFUT63",24,0) ; 0 if unable to determine if record local or not "RTN","DGPFUT63",25,0) ; DGPFAH - Output array containing the field values "RTN","DGPFUT63",26,0) ; Subscript Field# "RTN","DGPFUT63",27,0) ; ---------- ------ "RTN","DGPFUT63",28,0) ; "ENTERBY" .04 "RTN","DGPFUT63",29,0) ; "APPRVBY" .05 "RTN","DGPFUT63",30,0) ; "ORIGFAC" .09 "RTN","DGPFUT63",31,0) ; "RTN","DGPFUT63",32,0) N I,J,X,ISLOC,ORIG,RET,STN,WHO "RTN","DGPFUT63",33,0) S ORIG=+$G(DGIN("ORIGFAC")) I $$ISDIV^DGPFUT(ORIG)>0 Q 1 "RTN","DGPFUT63",34,0) ; "RTN","DGPFUT63",35,0) ; CREATED BY SITE field not present (dg*5.3*951) or not valued "RTN","DGPFUT63",36,0) S WHO=+$G(DGIN("APPRVBY")) "RTN","DGPFUT63",37,0) I 'WHO S WHO=+$G(DGIN("ENTERBY")) "RTN","DGPFUT63",38,0) Q (WHO>.9) "RTN","DGPFUT7") 0^9^B34083826^n/a "RTN","DGPFUT7",1,0) DGPFUT7 ;ALB/RBS - PRF COMMON PROMPTS ; 05/11/2018 10:00 "RTN","DGPFUT7",2,0) ;;5.3;Registration;**960**;Aug 13, 1993;Build 22 "RTN","DGPFUT7",3,0) ; Last Edited: SHRPE/sgm - May 29, 2018 17:14 "RTN","DGPFUT7",4,0) ; "RTN","DGPFUT7",5,0) ; ICR# TYPE DESCRIPTION "RTN","DGPFUT7",6,0) ;----- ---- ------------------------------------ "RTN","DGPFUT7",7,0) ; 2050 Sup MSG^DIALOG "RTN","DGPFUT7",8,0) ; 2055 Sup $$EXTERNAL^DILFD "RTN","DGPFUT7",9,0) ; "RTN","DGPFUT7",10,0) ;This routine contains common prompts asked in various DGPF routines. "RTN","DGPFUT7",11,0) ;DATA - checks to see if any assignments exist for a flag "RTN","DGPFUT7",12,0) ; "RTN","DGPFUT7",13,0) Q "RTN","DGPFUT7",14,0) ; "RTN","DGPFUT7",15,0) CAT() ; ----- prompt for Category I, II, Both "RTN","DGPFUT7",16,0) ; RETURN: -1 or 1^Catetory I (National) "RTN","DGPFUT7",17,0) ; 2^Category II (Local) "RTN","DGPFUT7",18,0) ; 3^Category I & II "RTN","DGPFUT7",19,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",20,0) S DGDIRA="Select Flag Category" "RTN","DGPFUT7",21,0) S DGDIRB="" "RTN","DGPFUT7",22,0) S DGDIRH="Enter one of the category selections to report on" "RTN","DGPFUT7",23,0) S DGDIRO="S^1:Category I (National);2:Category II (Local);3:Both" "RTN","DGPFUT7",24,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",25,0) S X="Category I (National)^Category II (Local)^Category I & II" "RTN","DGPFUT7",26,0) S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS)) "RTN","DGPFUT7",27,0) Q Y "RTN","DGPFUT7",28,0) ; "RTN","DGPFUT7",29,0) DATA() ; ----- check for any flag assignment "RTN","DGPFUT7",30,0) ;check for database for first assignment date "RTN","DGPFUT7",31,0) N X S X=$P(+$O(^DGPF(26.14,"D","")),".") I X Q X "RTN","DGPFUT7",32,0) S X=" >>> No Patient Record Flag Assignments have been found." "RTN","DGPFUT7",33,0) N MSG S MSG("DIMSG",1)=X D DIALOG(,"MSG") "RTN","DGPFUT7",34,0) Q $$E "RTN","DGPFUT7",35,0) ; "RTN","DGPFUT7",36,0) DIALOG(FLAG,INPUT) ; "RTN","DGPFUT7",37,0) ; .INPUT - required - passed by reference "RTN","DGPFUT7",38,0) N DTOUT,DUOUT "RTN","DGPFUT7",39,0) S FLAG=$G(FLAG) S:FLAG="" FLAG="MW" "RTN","DGPFUT7",40,0) I $G(INPUT)="" S INPUT="INPUT" "RTN","DGPFUT7",41,0) D MSG^DIALOG(FLAG,,,,"INPUT") "RTN","DGPFUT7",42,0) Q "RTN","DGPFUT7",43,0) ; "RTN","DGPFUT7",44,0) E(MSG) ; ----- ask user to press enter to continue "RTN","DGPFUT7",45,0) ; Return: -2:Time-out; -1:'^'-out 1:anything else "RTN","DGPFUT7",46,0) S MSG=$G(MSG) "RTN","DGPFUT7",47,0) N X,Y,Z,DIR,DIROUT,DIRUT,DTOUT,DUOUT "RTN","DGPFUT7",48,0) S DIR(0)="E" "RTN","DGPFUT7",49,0) I $L(MSG) S DIR("A")=MSG "RTN","DGPFUT7",50,0) D ^DIR "RTN","DGPFUT7",51,0) S X=$S($D(DTOUT):-2,$D(DUOUT):-1,1:1) "RTN","DGPFUT7",52,0) Q X "RTN","DGPFUT7",53,0) ; "RTN","DGPFUT7",54,0) FLAG() ; ----- prompt for All or Select Flag "RTN","DGPFUT7",55,0) ; RETURN: -1 or A:All Flags or S:Single Flag "RTN","DGPFUT7",56,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",57,0) S DGDIRA="Select to report on a (S)ingle flag or (A)ll flags" "RTN","DGPFUT7",58,0) S DGDIRB="Single Flag" "RTN","DGPFUT7",59,0) S DGDIRO="S^S:Single Flag;A:All Flags" "RTN","DGPFUT7",60,0) S DGDIRH="Enter one of the flag selections to report on" "RTN","DGPFUT7",61,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",62,0) I $L(ANS) S X=ANS_U_$S(ANS="S":"Single Flag",ANS="A":"All Flags",1:"") "RTN","DGPFUT7",63,0) S Y=$S('$L(ANS):-1,"AS"'[ANS:-1,1:X) "RTN","DGPFUT7",64,0) Q Y "RTN","DGPFUT7",65,0) ; "RTN","DGPFUT7",66,0) ONEFLAG(CAT,VALID) ; ----- prompt for name of flag "RTN","DGPFUT7",67,0) ; INPUT PARAMETERS: "RTN","DGPFUT7",68,0) ; CAT - optional - I:National Flag II:Local Flag "RTN","DGPFUT7",69,0) ; default to I "RTN","DGPFUT7",70,0) ; VALID - optional - 1:verify at least one assignment "RTN","DGPFUT7",71,0) ; 0:do not verify any current assignments "RTN","DGPFUT7",72,0) ; default to 1 "RTN","DGPFUT7",73,0) ; RETURN: -1 or "RTN","DGPFUT7",74,0) ; 0 if no flag assignments found "RTN","DGPFUT7",75,0) ; variable_pointer^flagname "RTN","DGPFUT7",76,0) ; "RTN","DGPFUT7",77,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO,DGFILE,FLAG,RET "RTN","DGPFUT7",78,0) S CAT=$G(CAT) I CAT'="I",CAT'="II" S CAT="I" "RTN","DGPFUT7",79,0) I CAT="I" S DGFILE=26.15 "RTN","DGPFUT7",80,0) I CAT="II" S DGFILE=26.11 "RTN","DGPFUT7",81,0) S VALID=$G(VALID) I VALID'=0,VALID'=1 S VALID=1 "RTN","DGPFUT7",82,0) S DGDIRA="Select Record Flag Name" "RTN","DGPFUT7",83,0) S DGDIRB="" "RTN","DGPFUT7",84,0) S DGDIRO="P^"_DGFILE_",.01:EMZ" "RTN","DGPFUT7",85,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO) "RTN","DGPFUT7",86,0) I ANS<1 Q -1 "RTN","DGPFUT7",87,0) S ANS=ANS_";DGPF("_DGFILE_"," "RTN","DGPFUT7",88,0) ; "RTN","DGPFUT7",89,0) S FLAG=$$EXTERNAL^DILFD(26.13,.02,"F",ANS) "RTN","DGPFUT7",90,0) S RET=ANS_U_FLAG "RTN","DGPFUT7",91,0) I 'VALID Q RET "RTN","DGPFUT7",92,0) ; "RTN","DGPFUT7",93,0) ; see if there is at least one assignment "RTN","DGPFUT7",94,0) I $$ASGNCNT^DGPFLF6(ANS) Q RET "RTN","DGPFUT7",95,0) ; "RTN","DGPFUT7",96,0) W !," >>> No Patient Record Flag Assignments have been found." "RTN","DGPFUT7",97,0) Q 0 "RTN","DGPFUT7",98,0) ; "RTN","DGPFUT7",99,0) OWNACT() ; -- prompt for local/not local ownership of assignment action "RTN","DGPFUT7",100,0) ; Use this for testing ^DD(26.14) ownership "RTN","DGPFUT7",101,0) ; RETURN: -1 or 1:Local Facility "RTN","DGPFUT7",102,0) ; 2:Other Facilities "RTN","DGPFUT7",103,0) ; 3:All Facilities "RTN","DGPFUT7",104,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",105,0) S DGDIRA="Select Ownership Type" "RTN","DGPFUT7",106,0) S DGDIRB="" "RTN","DGPFUT7",107,0) S DGDIRH="Local means this facility generated the PRF History action record" "RTN","DGPFUT7",108,0) S DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities" "RTN","DGPFUT7",109,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",110,0) S X="Local Facility^Other Facilities^All Facilities" "RTN","DGPFUT7",111,0) S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS)) "RTN","DGPFUT7",112,0) Q Y "RTN","DGPFUT7",113,0) ; "RTN","DGPFUT7",114,0) OWNASGN() ; ----- prompt for local/not local ownership of assignment "RTN","DGPFUT7",115,0) ; Use for testing ^DD(26.13,.04) OWNER SITE "RTN","DGPFUT7",116,0) ; RETURN: -1 or 1:Local Facility "RTN","DGPFUT7",117,0) ; 2:Other Facilities "RTN","DGPFUT7",118,0) ; 3:All Facilities "RTN","DGPFUT7",119,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",120,0) S DGDIRA="Select Ownership Type" "RTN","DGPFUT7",121,0) S DGDIRB="" "RTN","DGPFUT7",122,0) S DGDIRH="Local means the PRF assignment is owned by this facility" "RTN","DGPFUT7",123,0) S DGDIRO="S^1:Local Facility Only;2:Other Facilities;3:All Facilities" "RTN","DGPFUT7",124,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",125,0) S X="Local Facility^Other Facilities^All Facilities" "RTN","DGPFUT7",126,0) S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS)) "RTN","DGPFUT7",127,0) Q Y "RTN","DGPFUT7",128,0) ; "RTN","DGPFUT7",129,0) STATUS(BOTH) ; ----- prompt for assignment status "RTN","DGPFUT7",130,0) ; INPUT PARAMETER: Both - optional, default to 1 "RTN","DGPFUT7",131,0) ; 1:include both as a choice; 0:do not include both "RTN","DGPFUT7",132,0) ; Used for asking ^DD(26.13,.03) STATUS "RTN","DGPFUT7",133,0) ; RETURN: -1 or 1^Active "RTN","DGPFUT7",134,0) ; 2:^Inactive "RTN","DGPFUT7",135,0) ; 3^Both Active & Inactive "RTN","DGPFUT7",136,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",137,0) S BOTH=$G(BOTH) I 10'[$E(BOTH) S BOTH=1 "RTN","DGPFUT7",138,0) S DGDIRA="Select Current Assignment Status" "RTN","DGPFUT7",139,0) S DGDIRB="" "RTN","DGPFUT7",140,0) S DGDIRH="Enter the current assignment Status to be in the report" "RTN","DGPFUT7",141,0) S DGDIRO="S^1:Active;2:Inactive" S:BOTH DGDIRO=DGDIRO_";3:Both" "RTN","DGPFUT7",142,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",143,0) S X="Active^Inactive^Both Active & Inactive" "RTN","DGPFUT7",144,0) S Y=$S(ANS<1:-1,1:ANS_U_$P(X,U,ANS)) "RTN","DGPFUT7",145,0) Q Y "RTN","DGPFUT7",146,0) ; "RTN","DGPFUT7",147,0) ; Prompts for Asking Date Range "RTN","DGPFUT7",148,0) START(BEG,END) ; ----- prompt for starting date "RTN","DGPFUT7",149,0) ; INPUT PARAMTERS: "RTN","DGPFUT7",150,0) ; BEG - optional - earliest date allowed "RTN","DGPFUT7",151,0) ; END - optional - latest date allowed "RTN","DGPFUT7",152,0) ; default to DT "RTN","DGPFUT7",153,0) ; RETURN: -1 or Fileman date "RTN","DGPFUT7",154,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",155,0) S DGDIRA="Select Beginning Date" "RTN","DGPFUT7",156,0) S DGDIRB="" "RTN","DGPFUT7",157,0) S DGDIRH="^D HELP^DGPFUT7(1)" "RTN","DGPFUT7",158,0) S X=$G(BEG)_":"_$S(+$G(END):END,1:DT) "RTN","DGPFUT7",159,0) S DGDIRO="D^"_X_":EX" "RTN","DGPFUT7",160,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",161,0) S X=$S(ANS<1:-1,1:ANS) "RTN","DGPFUT7",162,0) Q X "RTN","DGPFUT7",163,0) ; "RTN","DGPFUT7",164,0) END(BEG,END) ; ----- prompt for ending date "RTN","DGPFUT7",165,0) ; INPUT PARAMTERS: "RTN","DGPFUT7",166,0) ; BEG - optional - earliest date allowed "RTN","DGPFUT7",167,0) ; END - optional - latest date allowed "RTN","DGPFUT7",168,0) ; default to DT "RTN","DGPFUT7",169,0) ; RETURN: -1 or Fileman date "RTN","DGPFUT7",170,0) N X,Y,ANS,DGDIRA,DGDIRB,DGDIRH,DGDIRO "RTN","DGPFUT7",171,0) S DGDIRA="Select Ending Date" "RTN","DGPFUT7",172,0) S DGDIRB="" "RTN","DGPFUT7",173,0) S DGDIRH="^D HELP^DGPFUT7(2)" "RTN","DGPFUT7",174,0) S X=$G(BEG)_":"_$S(+$G(END):END,1:DT) "RTN","DGPFUT7",175,0) S DGDIRO="D^"_X_":EX" "RTN","DGPFUT7",176,0) S ANS=$$ANSWER^DGPFUT(DGDIRA,DGDIRB,DGDIRO,DGDIRH) "RTN","DGPFUT7",177,0) S X=$S(ANS<1:-1,1:ANS) "RTN","DGPFUT7",178,0) Q X "RTN","DGPFUT7",179,0) ; "RTN","DGPFUT7",180,0) HELP(DGPF) ;provide extended DIR("?") help text. "RTN","DGPFUT7",181,0) ; "RTN","DGPFUT7",182,0) ; Input: DGSEL - prompt var for help text word selection "RTN","DGPFUT7",183,0) ; Output: none "RTN","DGPFUT7",184,0) ; "RTN","DGPFUT7",185,0) N A,T,MSG "RTN","DGPFUT7",186,0) S DGPF=$G(DGPF) S:DGPF="" DGPF=1 S DGPF=(DGPF=1) "RTN","DGPFUT7",187,0) S T=$P("latest^earliest",U,DGPF+1) "RTN","DGPFUT7",188,0) S A=" Enter the "_T_" Assignment Date to include in the report." "RTN","DGPFUT7",189,0) S MSG("DIMSG",1)=A "RTN","DGPFUT7",190,0) S A=" Please enter a date from the specified date range displayed." "RTN","DGPFUT7",191,0) S MSG("DIMSG",2)=A "RTN","DGPFUT7",192,0) D DIALOG(,"MSG") "RTN","DGPFUT7",193,0) Q "VER") 8.0^22.2 "BLD",10700,6) ^844 **END** **END**