SD376P ;BP-OIFO/esw,swo - POSTINSTALL DRIVER ; 10/27/04 3:39pm
;;5.3;Scheduling;**376**;Aug 13, 1993
EN ;manual entry point
;ST : station number
;STR : list of stations receiving AA ack's only
;STS : current station number with comma's concatenated
I '$$PROD^XUPROD(1) D Q
. D BMES^XPDUTL("NOT A PRODUCTION SYSTEM. POST INIT CANCELLED")
EN1 N ST,STR,STS
S ST=$P($$SITE^VASITE(),"^",3)
Q:ST=""
S STR=","_$P($T(STAT),";;",2)_","
S STS=","_ST_","
I STR[STS D EN^SDRPA18,CLEAN Q ;process stations that received AA ack only then quit
I ST=674 D EN^SDRPA17(ST),EN^SDRPA18,CLEAN Q
I ST<529 D EN^SDRPA10(ST),EN^SDRPA18,CLEAN Q
I ST<547 D EN^SDRPA11(ST),EN^SDRPA18,CLEAN Q
I ST<555 D EN^SDRPA12(ST),EN^SDRPA18,CLEAN Q
I ST<571 D EN^SDRPA13(ST),EN^SDRPA18,CLEAN Q
I ST<619 D EN^SDRPA14(ST),EN^SDRPA18,CLEAN Q
I ST<664 D EN^SDRPA15(ST),EN^SDRPA18,CLEAN Q
D EN^SDRPA16(ST),EN^SDRPA18,CLEAN Q
Q
PR(SB,SM,ER,SQ) ;process the message number and error code
;SB - Batch #
;SM - Message #
;ER - Error code
;SQ - Sequence number
;V1 - Run number
;V2 - ien in appt multiple
;V3 - ien in batch tracking multiple
;SM is the batch # found in the "AMSG" xref and corresponds to the message control id
;SB is our batch control, use for the 2 node multiples B xref lookups
N V1,V2,V3
;get the run number
S V1=$O(^SDWL(409.6,"AMSG",SM,SQ,"")) Q:'V1 D
. ;get the ien in that run
. S V2=$O(^SDWL(409.6,"AMSG",SM,SQ,V1,"")) Q:'V2 D
.. ;now get the ien of the batch tracking entry
.. S V3=$O(^SDWL(409.6,V1,2,"B",SB,"")) Q:'V3 D
... ;quit if there is an ack date
... I $P($G(^SDWL(409.6,V1,2,V3,0)),"^",4)'="" Q
... ;update batch tracking
... I ER="" S DA=V3,DA(1)=V1,DIE="^SDWL(409.6,"_V1_",2,",DR=".04///"_$$NOW^XLFDT_";.05///AE" D ^DIE K DIE,DA,DR Q
...;
...;update error codes
... S DA=V2,DA(1)=V1,DIE="^SDWL(409.6,"_V1_",1,"
... S DR="7////"_$O(^SCPT(404.472,"B",ER,"")) D ^DIE
... I $D(^SDWL(409.6,"AE","Y",V1,V2)) Q
... I $D(^SDWL(409.6,"AE","N",V1,V2)) D
.... S DR="4///Y" D ^DIE K DIE,DA,DR
Q
CLEAN ;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
;deleting if entry in xref exists
;RUN : run # (ien of multiple entry)
;V1 : previous run # (ien of multiple entry)
;V2 : ien (ien in multiple)
N V1,V2,V3,ZNODE
S V1=9999999 F S V1=$O(^SDWL(409.6,V1),-1) Q:'V1 D
.F V3="R","S" S V2=0 F S V2=$O(^SDWL(409.6,"AE",V3,V1,V2)) Q:'V2 D
..S ZNODE=$G(^SDWL(409.6,V1,1,V2,0))
..S DIK="^SDWL(409.6,"_V1_",1,"
..S DA(1)=V1,DA=V2 D ^DIK K DIK
Q
;listing of all stations that received only AA ack - no rejection
STAT ;;358,405,463,503,516,517,523,538,540,542,552,564,575,583,600,613,632,649,653,656,676,679,687,692,693,757
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD376P 2796 printed Apr 09, 2024@21:56:46 Page 2
SD376P ;BP-OIFO/esw,swo - POSTINSTALL DRIVER ; 10/27/04 3:39pm
+1 ;;5.3;Scheduling;**376**;Aug 13, 1993
EN ;manual entry point
+1 ;ST : station number
+2 ;STR : list of stations receiving AA ack's only
+3 ;STS : current station number with comma's concatenated
+4 IF '$$PROD^XUPROD(1)
Begin DoDot:1
+5 DO BMES^XPDUTL("NOT A PRODUCTION SYSTEM. POST INIT CANCELLED")
End DoDot:1
QUIT
EN1 NEW ST,STR,STS
+1 SET ST=$PIECE($$SITE^VASITE(),"^",3)
+2 if ST=""
QUIT
+3 SET STR=","_$PIECE($TEXT(STAT),";;",2)_","
+4 SET STS=","_ST_","
+5 ;process stations that received AA ack only then quit
IF STR[STS
DO EN^SDRPA18
DO CLEAN
QUIT
+6 IF ST=674
DO EN^SDRPA17(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+7 IF ST<529
DO EN^SDRPA10(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+8 IF ST<547
DO EN^SDRPA11(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+9 IF ST<555
DO EN^SDRPA12(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+10 IF ST<571
DO EN^SDRPA13(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+11 IF ST<619
DO EN^SDRPA14(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+12 IF ST<664
DO EN^SDRPA15(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+13 DO EN^SDRPA16(ST)
DO EN^SDRPA18
DO CLEAN
QUIT
+14 QUIT
PR(SB,SM,ER,SQ) ;process the message number and error code
+1 ;SB - Batch #
+2 ;SM - Message #
+3 ;ER - Error code
+4 ;SQ - Sequence number
+5 ;V1 - Run number
+6 ;V2 - ien in appt multiple
+7 ;V3 - ien in batch tracking multiple
+8 ;SM is the batch # found in the "AMSG" xref and corresponds to the message control id
+9 ;SB is our batch control, use for the 2 node multiples B xref lookups
+10 NEW V1,V2,V3
+11 ;get the run number
+12 SET V1=$ORDER(^SDWL(409.6,"AMSG",SM,SQ,""))
if 'V1
QUIT
Begin DoDot:1
+13 ;get the ien in that run
+14 SET V2=$ORDER(^SDWL(409.6,"AMSG",SM,SQ,V1,""))
if 'V2
QUIT
Begin DoDot:2
+15 ;now get the ien of the batch tracking entry
+16 SET V3=$ORDER(^SDWL(409.6,V1,2,"B",SB,""))
if 'V3
QUIT
Begin DoDot:3
+17 ;quit if there is an ack date
+18 IF $PIECE($GET(^SDWL(409.6,V1,2,V3,0)),"^",4)'=""
QUIT
+19 ;update batch tracking
+20 IF ER=""
SET DA=V3
SET DA(1)=V1
SET DIE="^SDWL(409.6,"_V1_",2,"
SET DR=".04///"_$$NOW^XLFDT_";.05///AE"
DO ^DIE
KILL DIE,DA,DR
QUIT
+21 ;
+22 ;update error codes
+23 SET DA=V2
SET DA(1)=V1
SET DIE="^SDWL(409.6,"_V1_",1,"
+24 SET DR="7////"_$ORDER(^SCPT(404.472,"B",ER,""))
DO ^DIE
+25 IF $DATA(^SDWL(409.6,"AE","Y",V1,V2))
QUIT
+26 IF $DATA(^SDWL(409.6,"AE","N",V1,V2))
Begin DoDot:4
+27 SET DR="4///Y"
DO ^DIE
KILL DIE,DA,DR
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
CLEAN ;clean up batches previous to current one by checking for "AE",("S" or "R") xref and
+1 ;deleting if entry in xref exists
+2 ;RUN : run # (ien of multiple entry)
+3 ;V1 : previous run # (ien of multiple entry)
+4 ;V2 : ien (ien in multiple)
+5 NEW V1,V2,V3,ZNODE
+6 SET V1=9999999
FOR
SET V1=$ORDER(^SDWL(409.6,V1),-1)
if 'V1
QUIT
Begin DoDot:1
+7 FOR V3="R","S"
SET V2=0
FOR
SET V2=$ORDER(^SDWL(409.6,"AE",V3,V1,V2))
if 'V2
QUIT
Begin DoDot:2
+8 SET ZNODE=$GET(^SDWL(409.6,V1,1,V2,0))
+9 SET DIK="^SDWL(409.6,"_V1_",1,"
+10 SET DA(1)=V1
SET DA=V2
DO ^DIK
KILL DIK
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;listing of all stations that received only AA ack - no rejection
STAT ;;358,405,463,503,516,517,523,538,540,542,552,564,575,583,600,613,632,649,653,656,676,679,687,692,693,757
