- RGP57PST ;BIR/PTD-POST-INIT TO RETIRE #218 EXCEPTIONS ;3/9/10
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**57**;30 Apr 99;Build 2
- ;
- ;Loop through the CIRN HL7 EXCEPTION LOG (#991.1) file.
- ;Find exceptions with EXCEPTION STATUS of NOT PROCESSED ("0").
- ;Get the TYPE which is a pointer to the CIRN HL7 EXCEPTION
- ;TYPE (#991.11) file. If the TYPE is 218 (Potential Matches
- ;Returned),mark the EXCEPTION STATUS to PROCESSED ("1").
- ;Exception type 218 is obsolete.
- ;
- EXLOG ;
- ;If patch RG*1.0*57 has previously been installed, quit post-init.
- I $$PATCH^XPDUTL("RG*1.0*57") D BMES^XPDUTL(" Post-install previously ran; no need to reprocess file 991.1 again.") Q
- ;Else continue with post-init.
- ;
- D BMES^XPDUTL(" The post-init routine will retire Potential Matches Returned (218)")
- D MES^XPDUTL(" exceptions in the CIRN HL7 EXCEPTION LOG (#991.1) file.")
- ;
- N COUNT,DA,DIC,DIE,DR,EXNUM,EXCTYP,LOGIEN,X,Y,ZNODE
- S (LOGIEN,COUNT)=0
- F S LOGIEN=$O(^RGHL7(991.1,LOGIEN)) Q:'LOGIEN D
- .S EXNUM=0
- .F S EXNUM=$O(^RGHL7(991.1,LOGIEN,1,EXNUM)) Q:'EXNUM S ZNODE=$G(^(EXNUM,0)) I $P(ZNODE,"^",5)'=1 D ;Quit if EXCEPTION STATUS (#6) equals 1 for PROCESSED
- ..S EXCTYP=$P(ZNODE,"^",3) ;Get exception TYPE
- ..I EXCTYP=218 D ;If TYPE is 218 - Potential Matches Returned DO
- ...;
- DIE ...;Update the EXCEPTION STATUS (#6) field to '1' - PROCESSED.
- ...S DA(1)=LOGIEN,DA=EXNUM,DR="6///"_1
- ...S DIE="^RGHL7(991.1,"_DA(1)_",1,"
- ...L +^RGHL7(991.1,LOGIEN):10
- ...D ^DIE K DA,DIE,DR
- ...L -^RGHL7(991.1,LOGIEN)
- ...S COUNT=COUNT+1
- ;
- D BMES^XPDUTL(" A total of "_COUNT_" Potential Matches Returned exceptions were retired.")
- D MES^XPDUTL(" Post-install routine completed successfully.")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGP57PST 1719 printed Jan 18, 2025@02:43:51 Page 2
- RGP57PST ;BIR/PTD-POST-INIT TO RETIRE #218 EXCEPTIONS ;3/9/10
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**57**;30 Apr 99;Build 2
- +2 ;
- +3 ;Loop through the CIRN HL7 EXCEPTION LOG (#991.1) file.
- +4 ;Find exceptions with EXCEPTION STATUS of NOT PROCESSED ("0").
- +5 ;Get the TYPE which is a pointer to the CIRN HL7 EXCEPTION
- +6 ;TYPE (#991.11) file. If the TYPE is 218 (Potential Matches
- +7 ;Returned),mark the EXCEPTION STATUS to PROCESSED ("1").
- +8 ;Exception type 218 is obsolete.
- +9 ;
- EXLOG ;
- +1 ;If patch RG*1.0*57 has previously been installed, quit post-init.
- +2 IF $$PATCH^XPDUTL("RG*1.0*57")
- DO BMES^XPDUTL(" Post-install previously ran; no need to reprocess file 991.1 again.")
- QUIT
- +3 ;Else continue with post-init.
- +4 ;
- +5 DO BMES^XPDUTL(" The post-init routine will retire Potential Matches Returned (218)")
- +6 DO MES^XPDUTL(" exceptions in the CIRN HL7 EXCEPTION LOG (#991.1) file.")
- +7 ;
- +8 NEW COUNT,DA,DIC,DIE,DR,EXNUM,EXCTYP,LOGIEN,X,Y,ZNODE
- +9 SET (LOGIEN,COUNT)=0
- +10 FOR
- SET LOGIEN=$ORDER(^RGHL7(991.1,LOGIEN))
- if 'LOGIEN
- QUIT
- Begin DoDot:1
- +11 SET EXNUM=0
- +12 ;Quit if EXCEPTION STATUS (#6) equals 1 for PROCESSED
- FOR
- SET EXNUM=$ORDER(^RGHL7(991.1,LOGIEN,1,EXNUM))
- if 'EXNUM
- QUIT
- SET ZNODE=$GET(^(EXNUM,0))
- IF $PIECE(ZNODE,"^",5)'=1
- Begin DoDot:2
- +13 ;Get exception TYPE
- SET EXCTYP=$PIECE(ZNODE,"^",3)
- +14 ;If TYPE is 218 - Potential Matches Returned DO
- IF EXCTYP=218
- Begin DoDot:3
- +15 ;
- DIE ;Update the EXCEPTION STATUS (#6) field to '1' - PROCESSED.
- +1 SET DA(1)=LOGIEN
- SET DA=EXNUM
- SET DR="6///"_1
- +2 SET DIE="^RGHL7(991.1,"_DA(1)_",1,"
- +3 LOCK +^RGHL7(991.1,LOGIEN):10
- +4 DO ^DIE
- KILL DA,DIE,DR
- +5 LOCK -^RGHL7(991.1,LOGIEN)
- +6 SET COUNT=COUNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +7 ;
- +8 DO BMES^XPDUTL(" A total of "_COUNT_" Potential Matches Returned exceptions were retired.")
- +9 DO MES^XPDUTL(" Post-install routine completed successfully.")
- +10 QUIT