- 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 Feb 19, 2025@00:15:02 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 ;