- 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 Feb 19, 2025@00:11:32 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