Routine: SD53142

SD53142 ;BP/JRP - POST INIT FOR PATCH SD*5.3*142;9-APR-1998

 ;;5.3;Scheduling;**142,1015**;AUG 13, 1993;Build 21

 ;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

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

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)

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")

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

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="@"

SD53142   ;BP/JRP - POST INIT FOR PATCH SD*5.3*142;9-APR-1998

 +1       ;;5.3;Scheduling;**142,1015**;AUG 13, 1993;Build 21

 +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

SD53142.m