SD53142 ;BP/JRP - POST INIT FOR PATCH SD*5.3*142;9-APR-1998
;;5.3;Scheduling;**142**;AUG 13, 1993
;
;Portions of this routine were copied from SD5370PT (ALB/ABR)
; and SCMSP66 (ALB/JLU)
;
PRE ;Main entry point for pre init
;Remove ERROR CODE DESCRIPTION (field #11) as an identifier of the
; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
; (this causes problems when installing error codes)
I ($D(^DD(409.76,0,"ID",11))) D
.N TMP
.K ^DD(409.76,0,"ID",11)
.Q:($D(^DD(409.76,0,"ID")))
.S TMP=$P(^SD(409.76,0),U,2)
.S TMP=$TR(TMP,"I","")
.S $P(^SD(409.76,0),U,2)=TMP
.Q
Q
;
POST ;Main entry point for post init
;Make ERROR CODE DESCRIPTION (field #11) an identifier of the
; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
; (this was removed by the pre init routine)
I ('$D(^DD(409.76,0,"ID",11))) D
.N TMP
.S ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
.S TMP=$P(^SD(409.76,0),U,2)
.S TMP=$TR(TMP,"I","")
.S $P(^SD(409.76,0),U,2)=TMP_"I"
;Change status of HL7 messages
D HLM
;Change HL7 application name
D HLAPP
Q
;
HLM ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
; to enable purging of message
N DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
S X=$$NOW^XLFDT()
S Y=$$FMTE^XLFDT(X)
S TEXT=">> Beginning HL7 Message Text file (#772) update on "
S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
D BMES^XPDUTL(TEXT)
S XPDIDTOT=+$O(^HL(772,"A"),-1)
S DIC="^HL(771,"
S DIC(0)="M"
S X="AMBCARE-DH70"
D ^DIC
I (Y<0) D Q
.D BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
S SDAPP=+Y
S HLMID=""
S COUNT=0
F S HLMID=$O(^HL(772,"AH",SDAPP,HLMID)) Q:(HLMID="") D
.S HLPTR=0
.F S HLPTR=+$O(^HL(772,"AH",SDAPP,HLMID,HLPTR)) Q:('HLPTR) D
..D UPDATE^XPDID(HLPTR)
..S DIE="^HL(772,"
..S DA=HLPTR
..S DR="20////3"
..D ^DIE
..S COUNT=COUNT+1
D UPDATE^XPDID(XPDIDTOT)
S X=$$NOW^XLFDT()
S Y=$$FMTE^XLFDT(X)
S TEXT=" Updating of HL7 Message Text file completed on "
S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
D MES^XPDUTL(TEXT)
S TEXT=" "_COUNT_" entries were updated"
D MES^XPDUTL(TEXT)
Q
;
HLAPP ;Change HL7 application name from AMBCARE-DH70 to AMBCARE-DH142
N DIE,DIC,DA,DR,X,Y
D BMES^XPDUTL(">> Changing HL7 Application name from AMBCARE-DH70 to AMBCARE-DH142")
S DIC="^HL(771,"
S DIC(0)="X"
S X="AMBCARE-DH70"
D ^DIC
I (Y<0) D Q
.D BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
S DIE=DIC
S DA=+Y
S DR=".01///AMBCARE-DH142"
D ^DIE
D MES^XPDUTL(" HL7 application name successfully changed to AMBCARE-DH142")
Q
;
;
DEL6050 ;Delete entries in Transmitted Outpatient Encounter file (#409.73)
;that are Lab stops to an OOS clinic and don't have any CPTs. Net
;result is removal of 6050 errors from error listing.
;
N IOP
S IOP="Q"
D EN^XUTMDEVQ("TASK6050^SD53142","DELETE ACRP 6050 ERRORS")
D HOME^%ZIS
Q
TASK6050 ;Entry point for tasking
;Declare variables
N L,DIC,FLDS,BY,FR,TO,DHD,DHIT,IOP,SD53142
;Sort through Transmitted Outpatient Encounter Error file (#409.75)
S L=""
S DIC="^SD(409.75,"
;Find entries that match the following criteria:
; (1) Error code is 6050
; (2) Related Visit file entry is a Lab stop
; (3) Related Visit file entry is at an OOS clinic
S BY="@.02,@.01:.02:.05:.08:1,@.01:.02:.05:.22:50.01"
S FR(1)="6050"
S TO(1)="6050"
S FR(2)="108"
S TO(2)="108"
S FR(3)="YES"
S TO(3)="YES"
;Print basic information about the entry
S FLDS="INTERNAL(#.01);""XMITPTR"""
S FLDS(1)=".01:.02:INTERNAL(NUMBER);""ENCPTR"""
S FLDS(2)=".01:.02:.05:INTERNAL(NUMBER);""VSITPTR"""
S FLDS(3)=".01:.02:.05:NUMDATE(#.01);""DATE"""
S FLDS(4)=".01:.02:.05:15001;L10;""VISIT ID"""
S FLDS(5)=".01:.02:.05:.08:1;L4;""AMIS"""
S FLDS(6)=".01:.02:.05:.22;L16;""CLINIC"""
;Delete entry from Transmitted Outpatient Encounter file
S DHIT="S ZJRP=$$DELXMIT^SCDXFU03(+$G(^SD(409.75,D0,0)),0) K ZJRP"
;Send output to current device
S IOP=IO
;Remember IO("S")
S SD53142=+$G(IO("S"))
;Call FileMan
S DHD="6050 ERRORS DELETED FROM ACRP FILES"
D EN1^DIP
;Reset IO("S")
S:(SD53142) IO("S")=SD53142
;Done
S:($D(ZTQUEUED)) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53142 4253 printed Oct 16, 2024@18:45:32 Page 2
SD53142 ;BP/JRP - POST INIT FOR PATCH SD*5.3*142;9-APR-1998
+1 ;;5.3;Scheduling;**142**;AUG 13, 1993
+2 ;
+3 ;Portions of this routine were copied from SD5370PT (ALB/ABR)
+4 ; and SCMSP66 (ALB/JLU)
+5 ;
PRE ;Main entry point for pre init
+1 ;Remove ERROR CODE DESCRIPTION (field #11) as an identifier of the
+2 ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
+3 ; (this causes problems when installing error codes)
+4 IF ($DATA(^DD(409.76,0,"ID",11)))
Begin DoDot:1
+5 NEW TMP
+6 KILL ^DD(409.76,0,"ID",11)
+7 if ($DATA(^DD(409.76,0,"ID")))
QUIT
+8 SET TMP=$PIECE(^SD(409.76,0),U,2)
+9 SET TMP=$TRANSLATE(TMP,"I","")
+10 SET $PIECE(^SD(409.76,0),U,2)=TMP
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
POST ;Main entry point for post init
+1 ;Make ERROR CODE DESCRIPTION (field #11) an identifier of the
+2 ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
+3 ; (this was removed by the pre init routine)
+4 IF ('$DATA(^DD(409.76,0,"ID",11)))
Begin DoDot:1
+5 NEW TMP
+6 SET ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
+7 SET TMP=$PIECE(^SD(409.76,0),U,2)
+8 SET TMP=$TRANSLATE(TMP,"I","")
+9 SET $PIECE(^SD(409.76,0),U,2)=TMP_"I"
End DoDot:1
+10 ;Change status of HL7 messages
+11 DO HLM
+12 ;Change HL7 application name
+13 DO HLAPP
+14 QUIT
+15 ;
HLM ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
+1 ; to enable purging of message
+2 NEW DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
+3 SET X=$$NOW^XLFDT()
+4 SET Y=$$FMTE^XLFDT(X)
+5 SET TEXT=">> Beginning HL7 Message Text file (#772) update on "
+6 SET TEXT=TEXT_$PIECE(Y,"@",1)_" @ "_$PIECE(Y,"@",2)
+7 DO BMES^XPDUTL(TEXT)
+8 SET XPDIDTOT=+$ORDER(^HL(772,"A"),-1)
+9 SET DIC="^HL(771,"
+10 SET DIC(0)="M"
+11 SET X="AMBCARE-DH70"
+12 DO ^DIC
+13 IF (Y<0)
Begin DoDot:1
+14 DO BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
End DoDot:1
QUIT
+15 SET SDAPP=+Y
+16 SET HLMID=""
+17 SET COUNT=0
+18 FOR
SET HLMID=$ORDER(^HL(772,"AH",SDAPP,HLMID))
if (HLMID="")
QUIT
Begin DoDot:1
+19 SET HLPTR=0
+20 FOR
SET HLPTR=+$ORDER(^HL(772,"AH",SDAPP,HLMID,HLPTR))
if ('HLPTR)
QUIT
Begin DoDot:2
+21 DO UPDATE^XPDID(HLPTR)
+22 SET DIE="^HL(772,"
+23 SET DA=HLPTR
+24 SET DR="20////3"
+25 DO ^DIE
+26 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+27 DO UPDATE^XPDID(XPDIDTOT)
+28 SET X=$$NOW^XLFDT()
+29 SET Y=$$FMTE^XLFDT(X)
+30 SET TEXT=" Updating of HL7 Message Text file completed on "
+31 SET TEXT=TEXT_$PIECE(Y,"@",1)_" @ "_$PIECE(Y,"@",2)
+32 DO MES^XPDUTL(TEXT)
+33 SET TEXT=" "_COUNT_" entries were updated"
+34 DO MES^XPDUTL(TEXT)
+35 QUIT
+36 ;
HLAPP ;Change HL7 application name from AMBCARE-DH70 to AMBCARE-DH142
+1 NEW DIE,DIC,DA,DR,X,Y
+2 DO BMES^XPDUTL(">> Changing HL7 Application name from AMBCARE-DH70 to AMBCARE-DH142")
+3 SET DIC="^HL(771,"
+4 SET DIC(0)="X"
+5 SET X="AMBCARE-DH70"
+6 DO ^DIC
+7 IF (Y<0)
Begin DoDot:1
+8 DO BMES^XPDUTL(" *** AMBCARE-DH70 application not found ***")
End DoDot:1
QUIT
+9 SET DIE=DIC
+10 SET DA=+Y
+11 SET DR=".01///AMBCARE-DH142"
+12 DO ^DIE
+13 DO MES^XPDUTL(" HL7 application name successfully changed to AMBCARE-DH142")
+14 QUIT
+15 ;
+16 ;
DEL6050 ;Delete entries in Transmitted Outpatient Encounter file (#409.73)
+1 ;that are Lab stops to an OOS clinic and don't have any CPTs. Net
+2 ;result is removal of 6050 errors from error listing.
+3 ;
+4 NEW IOP
+5 SET IOP="Q"
+6 DO EN^XUTMDEVQ("TASK6050^SD53142","DELETE ACRP 6050 ERRORS")
+7 DO HOME^%ZIS
+8 QUIT
TASK6050 ;Entry point for tasking
+1 ;Declare variables
+2 NEW L,DIC,FLDS,BY,FR,TO,DHD,DHIT,IOP,SD53142
+3 ;Sort through Transmitted Outpatient Encounter Error file (#409.75)
+4 SET L=""
+5 SET DIC="^SD(409.75,"
+6 ;Find entries that match the following criteria:
+7 ; (1) Error code is 6050
+8 ; (2) Related Visit file entry is a Lab stop
+9 ; (3) Related Visit file entry is at an OOS clinic
+10 SET BY="@.02,@.01:.02:.05:.08:1,@.01:.02:.05:.22:50.01"
+11 SET FR(1)="6050"
+12 SET TO(1)="6050"
+13 SET FR(2)="108"
+14 SET TO(2)="108"
+15 SET FR(3)="YES"
+16 SET TO(3)="YES"
+17 ;Print basic information about the entry
+18 SET FLDS="INTERNAL(#.01);""XMITPTR"""
+19 SET FLDS(1)=".01:.02:INTERNAL(NUMBER);""ENCPTR"""
+20 SET FLDS(2)=".01:.02:.05:INTERNAL(NUMBER);""VSITPTR"""
+21 SET FLDS(3)=".01:.02:.05:NUMDATE(#.01);""DATE"""
+22 SET FLDS(4)=".01:.02:.05:15001;L10;""VISIT ID"""
+23 SET FLDS(5)=".01:.02:.05:.08:1;L4;""AMIS"""
+24 SET FLDS(6)=".01:.02:.05:.22;L16;""CLINIC"""
+25 ;Delete entry from Transmitted Outpatient Encounter file
+26 SET DHIT="S ZJRP=$$DELXMIT^SCDXFU03(+$G(^SD(409.75,D0,0)),0) K ZJRP"
+27 ;Send output to current device
+28 SET IOP=IO
+29 ;Remember IO("S")
+30 SET SD53142=+$GET(IO("S"))
+31 ;Call FileMan
+32 SET DHD="6050 ERRORS DELETED FROM ACRP FILES"
+33 DO EN1^DIP
+34 ;Reset IO("S")
+35 if (SD53142)
SET IO("S")=SD53142
+36 ;Done
+37 if ($DATA(ZTQUEUED))
SET ZTREQ="@"
+38 QUIT
