SD53239P ;BPFO/JRP - PRE/POST INIT ROUTINE;5/29/2001
;;5.3;Scheduling;**239**;Aug 13, 1993
;
;The bulk of this routine was copied from routine SD53142
;
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,X
.S X(1)=" "
.S X(2)="Removing ERROR CODE DESCRIPTION (field #11) as an identifier"
.S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
.S X(4)="(#409.76) as it causes problems when installing error codes."
.S X(5)=" "
.D MES^XPDUTL(.X) K X
.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 of post init
N X,ZTRTN,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSK
;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 X(1)=" "
.S X(2)="Restoring ERROR CODE DESCRIPTION (field #11) as an identifier"
.S X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
.S X(4)="(#409.76) as it was removed by the pre init."
.S X(5)=" "
.D MES^XPDUTL(.X) K X
.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 HL7 application name
D HLAPP("AMBCARE-DH142","AMBCARE-DH239")
;Queue changing of HL7 message statuses
S ZTRTN="QHLM^SD53239P"
S ZTDESC="Change status of unacked AmbCare messages to SUCCESSFULLY COMPLETED"
S ZTIO=""
S ZTDTH=$H
D ^%ZTLOAD
K X
S X(1)=" "
S X(2)="Updating status of AmbCare messages that have not been acknowledged"
S X(3)="queued as task number "_$G(ZTSK)
S X(4)=" "
I '$G(ZTSK) D
.S X(1)=" "
.S X(2)="***** Updating status of AmbCare messages that have not been"
.S X(3)="***** acknowledged was not queued. This process must be done"
.S X(4)="***** in order for these messages to be properly purged."
.S X(5)="***** Use entry point QHLM^SD53239P to do this process."
.S X(6)=" "
D MES^XPDUTL(.X) K X
Q
;
HLAPP(OLDNAME,NEWNAME) ;Change HL7 application name
;Input : OLDNAME - Name of HL7 application to change
; NEWNAME - New name for HL7 application
;Output : None
;Notes : Call designed to be used as a KIDS pre/post init
S OLDNAME=$G(OLDNAME) Q:OLDNAME=""
S NEWNAME=$G(NEWNAME) Q:NEWNAME=""
N DIE,DIC,DA,DR,X,Y
D BMES^XPDUTL("Changing HL7 Application name from "_OLDNAME_" to "_NEWNAME)
S DIC="^HL(771,"
S DIC(0)="X"
S X=OLDNAME
D ^DIC
I (Y<0) D Q
.D BMES^XPDUTL(" *** "_OLDNAME_" application not found ***")
S DIE=DIC
S DA=+Y
S DR=".01///^S X=NEWNAME"
D ^DIE
D MES^XPDUTL("HL7 application name successfully changed to "_NEWNAME)
Q
;
QHLM ;Entry point for queued changing of HL7 messages
D HLM("AMBCARE-DH239")
Q
HLM(APPNAME) ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
; to enable purging of message
;Input : APPNAME - Name of application generating message
;Output : None
;Notes : Call must be used within KIDS (updates progress bar)
S APPNAME=$G(APPNAME) Q:APPNAME=""
N DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ
K ^TMP("SD53239P",$J)
S X=$$NOW^XLFDT()
S Y=$$FMTE^XLFDT(X)
S TEXT="Updating of HL7 Message Text file (#772) began on "
S TEXT=TEXT_$P(Y,"@",1)_" @ "_$P(Y,"@",2)
S ^TMP("SD53239P",$J,1,0)=TEXT
S DIC="^HL(771,"
S DIC(0)="M"
S X=APPNAME
D ^DIC
I (Y<0) D G HLMQ
.S ^TMP("SD53239P",$J,2,0)=" *** "_APPNAME_" application not found"
.S ^TMP("SD53239P",$J,3,0)=" *** Process aborted"
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
..S DIE="^HL(772,"
..S DA=HLPTR
..S DR="20////3"
..D ^DIE
..S COUNT=COUNT+1
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)
S ^TMP("SD53239P",$J,2,0)=TEXT
S ^TMP("SD53239P",$J,3,0)=COUNT_" entries were updated"
HLMQ S XMDUZ="Patch SD*5.3*239"
S XMSUB="Updating of HL7 Message Text file"
S XMTEXT="^TMP(""SD53239P"",$J,"
S XMY(DUZ)=""
D ^XMD
S ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53239P 4533 printed Apr 09, 2024@21:43:07 Page 2
SD53239P ;BPFO/JRP - PRE/POST INIT ROUTINE;5/29/2001
+1 ;;5.3;Scheduling;**239**;Aug 13, 1993
+2 ;
+3 ;The bulk of this routine was copied from routine SD53142
+4 ;
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,X
+6 SET X(1)=" "
+7 SET X(2)="Removing ERROR CODE DESCRIPTION (field #11) as an identifier"
+8 SET X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
+9 SET X(4)="(#409.76) as it causes problems when installing error codes."
+10 SET X(5)=" "
+11 DO MES^XPDUTL(.X)
KILL X
+12 KILL ^DD(409.76,0,"ID",11)
+13 if ($DATA(^DD(409.76,0,"ID")))
QUIT
+14 SET TMP=$PIECE(^SD(409.76,0),U,2)
+15 SET TMP=$TRANSLATE(TMP,"I","")
+16 SET $PIECE(^SD(409.76,0),U,2)=TMP
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
POST ;Main entry point of post init
+1 NEW X,ZTRTN,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSK
+2 ;Make ERROR CODE DESCRIPTION (field #11) an identifier of the
+3 ; TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file (#409.76)
+4 ; (this was removed by the pre init routine)
+5 IF ('$DATA(^DD(409.76,0,"ID",11)))
Begin DoDot:1
+6 NEW TMP
+7 SET X(1)=" "
+8 SET X(2)="Restoring ERROR CODE DESCRIPTION (field #11) as an identifier"
+9 SET X(3)="of the TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file"
+10 SET X(4)="(#409.76) as it was removed by the pre init."
+11 SET X(5)=" "
+12 DO MES^XPDUTL(.X)
KILL X
+13 SET ^DD(409.76,0,"ID",11)="D EN^DDIOL($P(^(1),U,1))"
+14 SET TMP=$PIECE(^SD(409.76,0),U,2)
+15 SET TMP=$TRANSLATE(TMP,"I","")
+16 SET $PIECE(^SD(409.76,0),U,2)=TMP_"I"
End DoDot:1
+17 ;Change HL7 application name
+18 DO HLAPP("AMBCARE-DH142","AMBCARE-DH239")
+19 ;Queue changing of HL7 message statuses
+20 SET ZTRTN="QHLM^SD53239P"
+21 SET ZTDESC="Change status of unacked AmbCare messages to SUCCESSFULLY COMPLETED"
+22 SET ZTIO=""
+23 SET ZTDTH=$HOROLOG
+24 DO ^%ZTLOAD
+25 KILL X
+26 SET X(1)=" "
+27 SET X(2)="Updating status of AmbCare messages that have not been acknowledged"
+28 SET X(3)="queued as task number "_$GET(ZTSK)
+29 SET X(4)=" "
+30 IF '$GET(ZTSK)
Begin DoDot:1
+31 SET X(1)=" "
+32 SET X(2)="***** Updating status of AmbCare messages that have not been"
+33 SET X(3)="***** acknowledged was not queued. This process must be done"
+34 SET X(4)="***** in order for these messages to be properly purged."
+35 SET X(5)="***** Use entry point QHLM^SD53239P to do this process."
+36 SET X(6)=" "
End DoDot:1
+37 DO MES^XPDUTL(.X)
KILL X
+38 QUIT
+39 ;
HLAPP(OLDNAME,NEWNAME) ;Change HL7 application name
+1 ;Input : OLDNAME - Name of HL7 application to change
+2 ; NEWNAME - New name for HL7 application
+3 ;Output : None
+4 ;Notes : Call designed to be used as a KIDS pre/post init
+5 SET OLDNAME=$GET(OLDNAME)
if OLDNAME=""
QUIT
+6 SET NEWNAME=$GET(NEWNAME)
if NEWNAME=""
QUIT
+7 NEW DIE,DIC,DA,DR,X,Y
+8 DO BMES^XPDUTL("Changing HL7 Application name from "_OLDNAME_" to "_NEWNAME)
+9 SET DIC="^HL(771,"
+10 SET DIC(0)="X"
+11 SET X=OLDNAME
+12 DO ^DIC
+13 IF (Y<0)
Begin DoDot:1
+14 DO BMES^XPDUTL(" *** "_OLDNAME_" application not found ***")
End DoDot:1
QUIT
+15 SET DIE=DIC
+16 SET DA=+Y
+17 SET DR=".01///^S X=NEWNAME"
+18 DO ^DIE
+19 DO MES^XPDUTL("HL7 application name successfully changed to "_NEWNAME)
+20 QUIT
+21 ;
QHLM ;Entry point for queued changing of HL7 messages
+1 DO HLM("AMBCARE-DH239")
+2 QUIT
HLM(APPNAME) ;Change status of HL7 messages to '3' (SUCCESSFULLY COMPLETED)
+1 ; to enable purging of message
+2 ;Input : APPNAME - Name of application generating message
+3 ;Output : None
+4 ;Notes : Call must be used within KIDS (updates progress bar)
+5 SET APPNAME=$GET(APPNAME)
if APPNAME=""
QUIT
+6 NEW DA,DIC,DIE,DR,X,Y,SDAPP,HLMID,XPDIDTOT,HLPTR,COUNT,TEXT
+7 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+8 KILL ^TMP("SD53239P",$JOB)
+9 SET X=$$NOW^XLFDT()
+10 SET Y=$$FMTE^XLFDT(X)
+11 SET TEXT="Updating of HL7 Message Text file (#772) began on "
+12 SET TEXT=TEXT_$PIECE(Y,"@",1)_" @ "_$PIECE(Y,"@",2)
+13 SET ^TMP("SD53239P",$JOB,1,0)=TEXT
+14 SET DIC="^HL(771,"
+15 SET DIC(0)="M"
+16 SET X=APPNAME
+17 DO ^DIC
+18 IF (Y<0)
Begin DoDot:1
+19 SET ^TMP("SD53239P",$JOB,2,0)=" *** "_APPNAME_" application not found"
+20 SET ^TMP("SD53239P",$JOB,3,0)=" *** Process aborted"
End DoDot:1
GOTO HLMQ
+21 SET SDAPP=+Y
+22 SET HLMID=""
+23 SET COUNT=0
+24 FOR
SET HLMID=$ORDER(^HL(772,"AH",SDAPP,HLMID))
if (HLMID="")
QUIT
Begin DoDot:1
+25 SET HLPTR=0
+26 FOR
SET HLPTR=+$ORDER(^HL(772,"AH",SDAPP,HLMID,HLPTR))
if ('HLPTR)
QUIT
Begin DoDot:2
+27 SET DIE="^HL(772,"
+28 SET DA=HLPTR
+29 SET DR="20////3"
+30 DO ^DIE
+31 SET COUNT=COUNT+1
End DoDot:2
End DoDot:1
+32 SET X=$$NOW^XLFDT()
+33 SET Y=$$FMTE^XLFDT(X)
+34 SET TEXT="Updating of HL7 Message Text file completed on "
+35 SET TEXT=TEXT_$PIECE(Y,"@",1)_" @ "_$PIECE(Y,"@",2)
+36 SET ^TMP("SD53239P",$JOB,2,0)=TEXT
+37 SET ^TMP("SD53239P",$JOB,3,0)=COUNT_" entries were updated"
HLMQ SET XMDUZ="Patch SD*5.3*239"
+1 SET XMSUB="Updating of HL7 Message Text file"
+2 SET XMTEXT="^TMP(""SD53239P"",$J,"
+3 SET XMY(DUZ)=""
+4 DO ^XMD
+5 SET ZTREQ="@"
+6 QUIT
