SD5370PT ;ALB/ABR - Initialize new parameters in Scheduling Param file ; 10/28/96
;;5.3;Scheduling;**70**;AUG 13, 1993
;
EN ;
I $G(^SD(404.91,1,"PATCH70")) D BMES^XPDUTL(" ** Cannot re-run this post-install **") Q ; do not allow re-run of post-install
D FILEK
D FILEC
D HLAPP
D SDPAR
D HLM
Q
FILEC ;clean up of file 409.73
N DIK,DA
D BMES^XPDUTL(">>Re-set of file 409.73 - TRANSMITTED OUTPATIENT ENCOUNTER begun")
N SDN,SDTEN,XPDIDTOT,SDI
D XREF
S SDN=0,XPDIDTOT=$P(^SD(409.73,0),U,4),SDTEN=XPDIDTOT\10+1
F SDI=1:1 S SDN=$O(^SD(409.73,SDN)) Q:'SDN D I '(SDI#SDTEN) D UPDATE^XPDID(SDI)
. I $P($G(^SD(409.73,SDN,0)),U,5)=3 D Q
.. ; remove deleted encounters records
.. S DIK="^SD(409.73,",DA=SDN D ^DIK
.. Q
. ; set to transmission not required, delete x-mit refs.
. S $P(^SD(409.73,SDN,0),U,4)=0,^(1)="^^^^"
. Q
Q
;
XREF ; x-ref cleanup
D MES^XPDUTL(">>cleaning up cross references.")
K ^SD(409.73,"AACBID"),^("AACLST"),^("AACMID"),^("AACNOACK"),^("AACXMIT")
Q
;
FILEK ; clear out files 409.74,409.75
N SDN,SDNODE
D MES^XPDUTL(">> Cleaning out DELETED OUTPATIENT ENCOUNTER file (#409.74)")
S SDNODE=$P(^SD(409.74,0),U,1,2)_"^0^0"
K ^SD(409.74)
S ^SD(409.74,0)=SDNODE ; reset 0-node
D MES^XPDUTL(">> Cleaning out TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75)")
S SDNODE=$P(^SD(409.75,0),U,1,2)_"^0^0"
K ^SD(409.75)
S ^SD(409.75,0)=SDNODE ; reset 0-node
Q
;
HLAPP ; change AMBCARE-DHCP application name to AMBCARE-DH70
N DIE,DIC,DA,DR,X,Y
S DIC="^HL(771,",DIC(0)="X",X="AMBCARE-DHCP" D ^DIC
I Y<0 D BMES^XPDUTL(">> AMBCARE-DHCP application not found") Q
S DIE=DIC,DA=+Y,DR=".01///AMBCARE-DH70" D ^DIE
Q
;
SDPAR ; This sets the SD70 INSTALL DATE to TODAY, and the
; SD70 LAST DATE to 9/30/96
; and AMBCARE MESSAGE LINES to 2000
N SDINS
S SDINS=$$HTFM^XLFDT($H)
S ^SD(404.91,1,"PATCH70")=SDINS_U_2960930,$P(^("AMB"),U,8)=2000
;
D BMES^XPDUTL("New Scheduling parameters initialized in file #404.91")
D MES^XPDUTL(" SD70 INSTALL DATE set to: "_$$FMTE^XLFDT(SDINS))
D MES^XPDUTL(" SD70 LAST DATE set to: Sept. 30, 1996")
D MES^XPDUTL(" AMBCARE MESSAGE LINES set to: 2000")
Q
;
HLM ; change status to '3' (SUCCESSFULLY COMPLETED) to enable purge of messages
D BMES^XPDUTL(">> Beginning HL7 message file update")
N DA,DIC,DIE,DR,X,Y,SDAPP,HLI,XPDIDTOT,HLC,HLTEN
S XPDIDTOT=$P($G(^HL(772,0)),U,4),HLTEN=XPDIDTOT\10+1
S DIC="^HL(771,",DIC(0)="M",X="AMBCARE-DH" D ^DIC
I Y<0 D BMES^XPDUTL(">> AMBCARE-DHCP application not found") Q
S SDAPP=+Y,DIE="^HL(772,",DR="20////3"
S HLI=0
F HLC=1:1 S HLI=$O(^HL(772,HLI)) Q:'HLI D I '(HLC#HLTEN) D UPDATE^XPDID(HLC)
. I $P($G(^HL(772,HLI,0)),U,3)'=SDAPP Q ;only edit AMBCARE entries.
. S DA=HLI D ^DIE
D MES^XPDUTL(">> HL7 message file update complete")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD5370PT 2857 printed Dec 13, 2024@02:45:23 Page 2
SD5370PT ;ALB/ABR - Initialize new parameters in Scheduling Param file ; 10/28/96
+1 ;;5.3;Scheduling;**70**;AUG 13, 1993
+2 ;
EN ;
+1 ; do not allow re-run of post-install
IF $GET(^SD(404.91,1,"PATCH70"))
DO BMES^XPDUTL(" ** Cannot re-run this post-install **")
QUIT
+2 DO FILEK
+3 DO FILEC
+4 DO HLAPP
+5 DO SDPAR
+6 DO HLM
+7 QUIT
FILEC ;clean up of file 409.73
+1 NEW DIK,DA
+2 DO BMES^XPDUTL(">>Re-set of file 409.73 - TRANSMITTED OUTPATIENT ENCOUNTER begun")
+3 NEW SDN,SDTEN,XPDIDTOT,SDI
+4 DO XREF
+5 SET SDN=0
SET XPDIDTOT=$PIECE(^SD(409.73,0),U,4)
SET SDTEN=XPDIDTOT\10+1
+6 FOR SDI=1:1
SET SDN=$ORDER(^SD(409.73,SDN))
if 'SDN
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^SD(409.73,SDN,0)),U,5)=3
Begin DoDot:2
+8 ; remove deleted encounters records
+9 SET DIK="^SD(409.73,"
SET DA=SDN
DO ^DIK
+10 QUIT
End DoDot:2
QUIT
+11 ; set to transmission not required, delete x-mit refs.
+12 SET $PIECE(^SD(409.73,SDN,0),U,4)=0
SET ^(1)="^^^^"
+13 QUIT
End DoDot:1
IF '(SDI#SDTEN)
DO UPDATE^XPDID(SDI)
+14 QUIT
+15 ;
XREF ; x-ref cleanup
+1 DO MES^XPDUTL(">>cleaning up cross references.")
+2 KILL ^SD(409.73,"AACBID"),^("AACLST"),^("AACMID"),^("AACNOACK"),^("AACXMIT")
+3 QUIT
+4 ;
FILEK ; clear out files 409.74,409.75
+1 NEW SDN,SDNODE
+2 DO MES^XPDUTL(">> Cleaning out DELETED OUTPATIENT ENCOUNTER file (#409.74)")
+3 SET SDNODE=$PIECE(^SD(409.74,0),U,1,2)_"^0^0"
+4 KILL ^SD(409.74)
+5 ; reset 0-node
SET ^SD(409.74,0)=SDNODE
+6 DO MES^XPDUTL(">> Cleaning out TRANSMITTED OUTPATIENT ENCOUNTER ERROR file (#409.75)")
+7 SET SDNODE=$PIECE(^SD(409.75,0),U,1,2)_"^0^0"
+8 KILL ^SD(409.75)
+9 ; reset 0-node
SET ^SD(409.75,0)=SDNODE
+10 QUIT
+11 ;
HLAPP ; change AMBCARE-DHCP application name to AMBCARE-DH70
+1 NEW DIE,DIC,DA,DR,X,Y
+2 SET DIC="^HL(771,"
SET DIC(0)="X"
SET X="AMBCARE-DHCP"
DO ^DIC
+3 IF Y<0
DO BMES^XPDUTL(">> AMBCARE-DHCP application not found")
QUIT
+4 SET DIE=DIC
SET DA=+Y
SET DR=".01///AMBCARE-DH70"
DO ^DIE
+5 QUIT
+6 ;
SDPAR ; This sets the SD70 INSTALL DATE to TODAY, and the
+1 ; SD70 LAST DATE to 9/30/96
+2 ; and AMBCARE MESSAGE LINES to 2000
+3 NEW SDINS
+4 SET SDINS=$$HTFM^XLFDT($HOROLOG)
+5 SET ^SD(404.91,1,"PATCH70")=SDINS_U_2960930
SET $PIECE(^("AMB"),U,8)=2000
+6 ;
+7 DO BMES^XPDUTL("New Scheduling parameters initialized in file #404.91")
+8 DO MES^XPDUTL(" SD70 INSTALL DATE set to: "_$$FMTE^XLFDT(SDINS))
+9 DO MES^XPDUTL(" SD70 LAST DATE set to: Sept. 30, 1996")
+10 DO MES^XPDUTL(" AMBCARE MESSAGE LINES set to: 2000")
+11 QUIT
+12 ;
HLM ; change status to '3' (SUCCESSFULLY COMPLETED) to enable purge of messages
+1 DO BMES^XPDUTL(">> Beginning HL7 message file update")
+2 NEW DA,DIC,DIE,DR,X,Y,SDAPP,HLI,XPDIDTOT,HLC,HLTEN
+3 SET XPDIDTOT=$PIECE($GET(^HL(772,0)),U,4)
SET HLTEN=XPDIDTOT\10+1
+4 SET DIC="^HL(771,"
SET DIC(0)="M"
SET X="AMBCARE-DH"
DO ^DIC
+5 IF Y<0
DO BMES^XPDUTL(">> AMBCARE-DHCP application not found")
QUIT
+6 SET SDAPP=+Y
SET DIE="^HL(772,"
SET DR="20////3"
+7 SET HLI=0
+8 FOR HLC=1:1
SET HLI=$ORDER(^HL(772,HLI))
if 'HLI
QUIT
Begin DoDot:1
+9 ;only edit AMBCARE entries.
IF $PIECE($GET(^HL(772,HLI,0)),U,3)'=SDAPP
QUIT
+10 SET DA=HLI
DO ^DIE
End DoDot:1
IF '(HLC#HLTEN)
DO UPDATE^XPDID(HLC)
+11 DO MES^XPDUTL(">> HL7 message file update complete")
+12 QUIT
