DGPFXCRN ; ALB/CNF/CMF - UTILITY TO DISABLE CAT II PRF AFTER CERNER ; 10-05-2019
;;5.3;Registration;**1005**;Aug 13, 1993;Build 57
;
;Tag EN is entry point
Q
;
;*****************************************************************
;**** DO NOT RUN THIS CODE UNTIL THE SITE MOVES PRF TO CERNER ****
;*****************************************************************
;
; To disable Patient Record Flags after Cerner, mark PRF options
; as out of order so flags can't be added or edited from VistA.
;
; Mark all CAT II flags as inactive so CAT II flags are no longer
; displayed for legacy products remaining on VistA.
;
POST ; Entry point for post install from KIDS
D CAT2 ;Inactivate Category II flags
;
Q
;
CAT2 ;
N FLGNM,FLG,DGPFLH,DGPFLF
;
D BMES^XPDUTL("Inactivate Category II Patient Record Flags (Local patient record flags).")
D MES^XPDUTL("All patient assignments for category II flags will be inactivated.")
;
; Loop through active category II patient record flags
S MSG="PRF functionality inactivated after migration to Cerner"
S FLGNM=""
F S FLGNM=$O(^DGPF(26.11,"ASTAT",1,FLGNM)) Q:FLGNM="" D
. S FLG=$O(^DGPF(26.11,"ASTAT",1,FLGNM,0)) Q:FLG=""
. D DEACT(FLG,FLGNM,MSG)
. Q
;
Q
;
DEACT(FLG,FLGNM,MSG) ;Deactivate; called from DG*1005 post init; called from DG*991 post init
;
N DGIDXIEN ;ien of flag record
N DGPFLF ;array containing flag record field values
N DGPFLH ;array containing flag history record field values
N DGABORT ;abort flag
N DGRESULT ;result of $$STOALL^DGPFALF1 api call
N DGERR ;if error returned
N DGOK ;ok flag to enter record flag entry & flag description
N DGMSG ;user message
N DGX ;temp variable
;
; init variables
S (DGABORT,DGRESULT)=0
S DGOK=1
;
S DGIDXIEN=FLG
K DGPFLF,DGPFLH
;
; call api to get record back in array DGPFLF with existing record entries
I '$$GETLF^DGPFALF($P(DGIDXIEN,";"),.DGPFLF) Q ; If true, record can't be found
;
; Set array to change entries in 26.11
S DGPFLF("FLAG")=FLGNM ;flag description
S DGPFLF("STAT")="0^INACTIVE" ;change to inactive
;
; setup remaining flag history array nodes for filing in 26.12
S DGPFLH("FLAG")=FLGNM ;flag description
S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time
S DGPFLH("ENTERBY")=DUZ ;current user
S DGX="^^1^1^"_($P(DGPFLH("ENTERDT"),".",1))_"^"
S DGPFLH("REASON",0)=DGX ;reason array
S DGPFLH("REASON",1,0)=MSG
;
; Inactivate the category II patient record flag which will also trigger
; inactivation of all active patient record flag assignment records in
; the PRF ASSIGNMENT (#26.13) file associated with this flag.
;
; file both the (#26.11) & (#26.12) entries
S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
;
D MES^XPDUTL("Local record flag "_FLGNM_" inactivation was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."))
;
Q
;
OPT ; List of options to mark out of order
;/DGPF BACKGROUND PROCESSING/Patient Record Flag Background
;/DGPF ENABLE DIVISIONS/Record Flag Enable Divisions
;/DGPF LOCAL TO NATIONAL CONVERT/Convert Local HRMH PRF to National
;/DGPF MANUAL QUERY/Record Flag Manual Query
;/DGPF PRF TRANSFER REQUESTS/Record Flag Transfer Requests
;/DGPF PRINCIPAL INVEST REPORT/Assignments by Principal Investigator Report
;/DGPF RECORD FLAG ASSIGNMENT/Record Flag Assignment
;/DGPF RECORD FLAG MANAGEMENT/Record Flag Management
;/DGPF RECORD REFRESH/Record Flag Data Refresh
;/DGPF TRANSMISSION ERRORS/Record Flag Transmission Errors
;/DGPF TRANSMISSION MGMT/Record Flag Transmission Mgmt
;//;
; Note reporting options are left enabled
;
FAIL ;
W !!?4,"Unable to find option: ",OPT," ",OPTNM
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFXCRN 3834 printed Sep 23, 2025@20:24:52 Page 2
DGPFXCRN ; ALB/CNF/CMF - UTILITY TO DISABLE CAT II PRF AFTER CERNER ; 10-05-2019
+1 ;;5.3;Registration;**1005**;Aug 13, 1993;Build 57
+2 ;
+3 ;Tag EN is entry point
+4 QUIT
+5 ;
+6 ;*****************************************************************
+7 ;**** DO NOT RUN THIS CODE UNTIL THE SITE MOVES PRF TO CERNER ****
+8 ;*****************************************************************
+9 ;
+10 ; To disable Patient Record Flags after Cerner, mark PRF options
+11 ; as out of order so flags can't be added or edited from VistA.
+12 ;
+13 ; Mark all CAT II flags as inactive so CAT II flags are no longer
+14 ; displayed for legacy products remaining on VistA.
+15 ;
POST ; Entry point for post install from KIDS
+1 ;Inactivate Category II flags
DO CAT2
+2 ;
+3 QUIT
+4 ;
CAT2 ;
+1 NEW FLGNM,FLG,DGPFLH,DGPFLF
+2 ;
+3 DO BMES^XPDUTL("Inactivate Category II Patient Record Flags (Local patient record flags).")
+4 DO MES^XPDUTL("All patient assignments for category II flags will be inactivated.")
+5 ;
+6 ; Loop through active category II patient record flags
+7 SET MSG="PRF functionality inactivated after migration to Cerner"
+8 SET FLGNM=""
+9 FOR
SET FLGNM=$ORDER(^DGPF(26.11,"ASTAT",1,FLGNM))
if FLGNM=""
QUIT
Begin DoDot:1
+10 SET FLG=$ORDER(^DGPF(26.11,"ASTAT",1,FLGNM,0))
if FLG=""
QUIT
+11 DO DEACT(FLG,FLGNM,MSG)
+12 QUIT
End DoDot:1
+13 ;
+14 QUIT
+15 ;
DEACT(FLG,FLGNM,MSG) ;Deactivate; called from DG*1005 post init; called from DG*991 post init
+1 ;
+2 ;ien of flag record
NEW DGIDXIEN
+3 ;array containing flag record field values
NEW DGPFLF
+4 ;array containing flag history record field values
NEW DGPFLH
+5 ;abort flag
NEW DGABORT
+6 ;result of $$STOALL^DGPFALF1 api call
NEW DGRESULT
+7 ;if error returned
NEW DGERR
+8 ;ok flag to enter record flag entry & flag description
NEW DGOK
+9 ;user message
NEW DGMSG
+10 ;temp variable
NEW DGX
+11 ;
+12 ; init variables
+13 SET (DGABORT,DGRESULT)=0
+14 SET DGOK=1
+15 ;
+16 SET DGIDXIEN=FLG
+17 KILL DGPFLF,DGPFLH
+18 ;
+19 ; call api to get record back in array DGPFLF with existing record entries
+20 ; If true, record can't be found
IF '$$GETLF^DGPFALF($PIECE(DGIDXIEN,";"),.DGPFLF)
QUIT
+21 ;
+22 ; Set array to change entries in 26.11
+23 ;flag description
SET DGPFLF("FLAG")=FLGNM
+24 ;change to inactive
SET DGPFLF("STAT")="0^INACTIVE"
+25 ;
+26 ; setup remaining flag history array nodes for filing in 26.12
+27 ;flag description
SET DGPFLH("FLAG")=FLGNM
+28 ;current date/time
SET DGPFLH("ENTERDT")=$$NOW^XLFDT()
+29 ;current user
SET DGPFLH("ENTERBY")=DUZ
+30 SET DGX="^^1^1^"_($PIECE(DGPFLH("ENTERDT"),".",1))_"^"
+31 ;reason array
SET DGPFLH("REASON",0)=DGX
+32 SET DGPFLH("REASON",1,0)=MSG
+33 ;
+34 ; Inactivate the category II patient record flag which will also trigger
+35 ; inactivation of all active patient record flag assignment records in
+36 ; the PRF ASSIGNMENT (#26.13) file associated with this flag.
+37 ;
+38 ; file both the (#26.11) & (#26.12) entries
+39 SET DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
+40 ;
+41 DO MES^XPDUTL("Local record flag "_FLGNM_" inactivation was "_$SELECT(+DGRESULT:"filed successfully.",1:"not filed successfully."))
+42 ;
+43 QUIT
+44 ;
OPT ; List of options to mark out of order
+1 ;/DGPF BACKGROUND PROCESSING/Patient Record Flag Background
+2 ;/DGPF ENABLE DIVISIONS/Record Flag Enable Divisions
+3 ;/DGPF LOCAL TO NATIONAL CONVERT/Convert Local HRMH PRF to National
+4 ;/DGPF MANUAL QUERY/Record Flag Manual Query
+5 ;/DGPF PRF TRANSFER REQUESTS/Record Flag Transfer Requests
+6 ;/DGPF PRINCIPAL INVEST REPORT/Assignments by Principal Investigator Report
+7 ;/DGPF RECORD FLAG ASSIGNMENT/Record Flag Assignment
+8 ;/DGPF RECORD FLAG MANAGEMENT/Record Flag Management
+9 ;/DGPF RECORD REFRESH/Record Flag Data Refresh
+10 ;/DGPF TRANSMISSION ERRORS/Record Flag Transmission Errors
+11 ;/DGPF TRANSMISSION MGMT/Record Flag Transmission Mgmt
+12 ;//;
+13 ; Note reporting options are left enabled
+14 ;
FAIL ;
+1 WRITE !!?4,"Unable to find option: ",OPT," ",OPTNM
+2 QUIT
+3 ;
