DGY991PO ; ALB/CNF/CMF/GXT - UTILITY TO INACTIVATE CAT2 PRFS ; Feb 12, 2026@07:58:55
;;5.3;Registration;**991**;;Build 12
;
; Use of $$CRNRSITE^VAFCCRNR supported by ICR #7346.
;
Q
;
ENTRY ;
N X I '$$CRNRSITE^VAFCCRNR($P($$SITE^VASITE(),U,3)) W !!,"*** CAN BE RUN ON CONVERTED SITES ONLY ***",! R !,"Press [RETURN] to continue",X:$G(DTIME,300) Q
D CAT2,OUTOOM
Q
;
CAT2 ;
N FLGNM,FLG,DGPFLH,DGPFLF ;
;
W !,"Inactivate Category II Patient Record Flags (Local patient record flags).",!!
W "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 Federal EHR"
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
;
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)
;
W "Local record flag "_FLGNM_" inactivation was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),!
;
Q
;
OUTOOM ;
N PXI,PXLINE,OPTION,TEXT
F PXI=1:1 S PXLINE=$P($T(OPT+PXI),";;",2) Q:PXLINE="" D
. S OPTION=PXLINE
. S TEXT="PRF functionality inactivated after migration to Federal EHR"
. D OUT^XPDMENU(OPTION,TEXT)
Q
;
OPT ; List of options to mark out of order
;;DGPF BACKGROUND PROCESSING
;;DGPF ENABLE DIVISIONS
;;DGPF LOCAL TO NATIONAL CONVERT
;;DGPF MANUAL QUERY
;;DGPF PRF TRANSFER REQUESTS
;;DGPF PRINCIPAL INVEST REPORT
;;DGPF RECORD FLAG ASSIGNMENT
;;DGPF RECORD FLAG MANAGEMENT
;;DGPF RECORD REFRESH
;;DGPF TRANSMISSION ERRORS
;;DGPF TRANSMISSION MGMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGY991PO 3119 printed Jul 11, 2026@02:56:28 Page 2
DGY991PO ; ALB/CNF/CMF/GXT - UTILITY TO INACTIVATE CAT2 PRFS ; Feb 12, 2026@07:58:55
+1 ;;5.3;Registration;**991**;;Build 12
+2 ;
+3 ; Use of $$CRNRSITE^VAFCCRNR supported by ICR #7346.
+4 ;
+5 QUIT
+6 ;
ENTRY ;
+1 NEW X
IF '$$CRNRSITE^VAFCCRNR($PIECE($$SITE^VASITE(),U,3))
WRITE !!,"*** CAN BE RUN ON CONVERTED SITES ONLY ***",!
READ !,"Press [RETURN] to continue",X:$GET(DTIME,300)
QUIT
+2 DO CAT2
DO OUTOOM
+3 QUIT
+4 ;
CAT2 ;
+1 ;
NEW FLGNM,FLG,DGPFLH,DGPFLF
+2 ;
+3 WRITE !,"Inactivate Category II Patient Record Flags (Local patient record flags).",!!
+4 WRITE "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 Federal EHR"
+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
+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 WRITE "Local record flag "_FLGNM_" inactivation was "_$SELECT(+DGRESULT:"filed successfully.",1:"not filed successfully."),!
+42 ;
+43 QUIT
+44 ;
OUTOOM ;
+1 NEW PXI,PXLINE,OPTION,TEXT
+2 FOR PXI=1:1
SET PXLINE=$PIECE($TEXT(OPT+PXI),";;",2)
if PXLINE=""
QUIT
Begin DoDot:1
+3 SET OPTION=PXLINE
+4 SET TEXT="PRF functionality inactivated after migration to Federal EHR"
+5 DO OUT^XPDMENU(OPTION,TEXT)
End DoDot:1
+6 QUIT
+7 ;
OPT ; List of options to mark out of order
+1 ;;DGPF BACKGROUND PROCESSING
+2 ;;DGPF ENABLE DIVISIONS
+3 ;;DGPF LOCAL TO NATIONAL CONVERT
+4 ;;DGPF MANUAL QUERY
+5 ;;DGPF PRF TRANSFER REQUESTS
+6 ;;DGPF PRINCIPAL INVEST REPORT
+7 ;;DGPF RECORD FLAG ASSIGNMENT
+8 ;;DGPF RECORD FLAG MANAGEMENT
+9 ;;DGPF RECORD REFRESH
+10 ;;DGPF TRANSMISSION ERRORS
+11 ;;DGPF TRANSMISSION MGMT
