ASUMKBPS ; IHS/ITSC/LMH -UPDATE ISSUE BOOK MASTER ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility which is invoked to update the Issue Book
;Master file. The Issue Book master file is used to capture
;statistics concerning Issues.
I $G(ASUT(ASUT,"B/O"))="B"&$G(ASUT(ASUT,"FPN"))="N" Q
I $E(ASUT("TRCD"))=0 D
.S ASUMK("E#","STA")=$G(ASUT(ASUT,"PT","STA"))
E D
.S ASUMK("E#","STA")=$G(ASUMS("E#","STA"))
S ASUMK("E#","REQ")=ASUT(ASUT,"PT","REQ")
D STA^ASUMKBIO(ASUMK("E#","STA")) ;Lookup STA in Issue Book Master
I Y<1 D Q:$D(DDSERROR)
.I Y=0 D
..D ADDSTA^ASUMKBIO(ASUMK("E#","STA")) ;Add STA to Issue Book master
..I Y<0 D
...N Z S Z="Error adding STA : "_ASUMK("E#","STA")_" to YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=1 ;DFM P1 9/1/98
.E D
..N Z S Z="Error finding STA : "_ASUMK("E#","STA")_" for YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=2 ;DFM P1 9/1/98
D REQ^ASUMKBIO(ASUMK("E#","REQ")) ;Lookup REQ in Issue Book master
I Y<1 D Q:$D(DDSERROR)
.I Y=0 D
..D ADDREQ^ASUMKBIO(ASUMK("E#","REQ")) ;Add REQ to Issue Book master
..I Y<0 D
...N Z S Z="Error adding REQ : "_ASUMK("E#","REQ")_" to YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=3 ;DFM P1 9/1/98
.E D
..N Z S Z="Error finding REQ : "_ASUMK("E#","REQ")_" for YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=4 ;DFM P1 9/1/98
I ASUT("TYPE")=7 D
.S ASUMX("E#","IDX")="99999999"
E D
.D IDX^ASUMKBIO(ASUMX("E#","IDX")) ;Lookup IDX in Issue Book master
I Y<1 D Q:$D(DDSERROR)
.I Y=0 D
..D ADDIDX^ASUMKBIO(ASUMK("E#","IDX")) ;Add IDX to Issue Book master
..I Y<0 D
...N Z S Z="Error adding IDX : "_ASUMK("E#","IDX")_" to YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=5 ;DFM P1 9/1/98
.E D
..N Z S Z="Error finding IDX : "_ASUMK("E#","IDX")_" for YTD DATA -RC : "_Y W *7 D HLP^ASUJHELP(.Z) S DDSERROR=6 ;DFM P1 9/1/98
D READ^ASUMKBIO ;Read Issue Book master into variables
I ASUT("TRCD")="5B" D
.S ASUMK("ULQTY")=$S(ASUT(ASUT,"ULVQTY")=0:"",1:ASUT(ASUT,"ULVQTY"))
.S ASUMK("PULQTY")=1
E D
.S ASUV("MO")=+($P(ASUT(ASUT,"VOU"),"-",2))
.Q:ASUV("MO")']""
.I $E(ASUT("TRCD"),2)?1A D
..S ASUMK(ASUV("MO"),"DOC")=$G(ASUMK(ASUV("MO"),"DOC"))-1
..S ASUMK(ASUV("MO"),"QTY")=$G(ASUMK(ASUV("MO"),"QTY"))-ASUT(ASUT,"QTY","ISS")
..S ASUMK("CFY","VAL")=$G(ASUMK("CFY","VAL"))-(ASUT(ASUT,"VAL"))
.E D
..I ASUT("TRCD")'="31" D
...S ASUMK(ASUV("MO"),"DOC")=$G(ASUMK(ASUV("MO"),"DOC"))+1
..S ASUMK(ASUV("MO"),"QTY")=$G(ASUMK(ASUV("MO"),"QTY"))+ASUT(ASUT,"QTY","ISS")
..S ASUMK("CFY","VAL")=$G(ASUMK("CFY","VAL"))+(ASUT(ASUT,"VAL"))
D EN1^ASUMKBIO
Q
CLMO ;EP ;CLEAR MONTH
S ASUMK("MO")=ASUP("MO")+1 S:ASUMK("MO")=13 ASUMK("MO")=1
CLSM ;EP ;CLEAR PREVIOUSLY SELECTED MONTH
S (ASUMK("E#","STA"),ASUMK("E#","REQ"),ASUMK("E#","IDX"))=0
F S ASUMK("E#","STA")=$O(^ASUMK(ASUMK("E#","STA"))) Q:ASUMK("E#","STA")'?1N.N D
.F S ASUMK("E#","REQ")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"))) Q:ASUMK("E#","REQ")'?1N.N D
..F S ASUMK("E#","IDX")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"),1,ASUMK("E#","IDX"))) Q:ASUMK("E#","IDX")'?1N.N D
...D READ^ASUMKBIO
...S ASUMK(ASUMK("MO"),"DOC")=""
...S ASUMK(ASUMK("MO"),"QTY")=""
...S ASUMK("NOKL")=1 D EN1^ASUMKBIO
..S ASUMK("E#","IDX")=0
.S ASUMK("E#","REQ")=0,ASUMK("E#","IDX")=0
K ASUMK
Q
CLYR ;EP; CLEAR YEARLY
S ASUP("CKY")=+$G(ASUP("CKY"))
D DATE^ASUUDATE,TIME^ASUUDATE
S ASURX="W !,""S.A.M.S. Beginning of Year Update Procedure begun "_ASUK("DT","TIME")_"""" D ^ASUUPLOG
I ASUP("CKY")=0 S ASUP("CKY")=1 D SETSY^ASUCOSTS
I ASUP("CKY")=1 D ASUYPSYR G:ASUP("HLT") DONE S ASUP("CKY")=2 D SETSY^ASUCOSTS
I ASUP("CKY")=2 D ASUKPSYR G:ASUP("HLT") DONE S ASUP("CKY")=3 D SETSY^ASUCOSTS
I ASUP("CKY")=3 D G:ASUP("HLT") DONE S ASUP("CKY")=4 D SETSY^ASUCOSTS
.S ASURX="W !,""Clearing Transaction History Files""" D ^ASUUPLOG
.D EN2^ASU0PURG
I ASUP("CKY")=4 D
.S ASUU("E#")=""
.F S ASUU("E#")=$O(^ASUR1(ASUU("E#"))) Q:ASUU("E#")="" Q:ASUU("E#")="B" F ASUC("TR")=4,5,7,8,10,11,13,14,16,17,19,20 S $P(^ASUR1(ASUU("E#"),0),U,ASUC("TR"))=0
.K ASU
.S ASUP("CKY")=5 D SETSY^ASUCOSTS
Q:$G(ASUP("HLT"))
D TIME^ASUUDATE
S ASURX="W !,""S.A.M.S. Beginning of Year Update Procedure ended "_ASUK("DT","TIME")_"""" D ^ASUUPLOG
Q
DONE ;
S ASUP("HLT")=1
Q
ASUYPSYR ;
S ASURX="W !,""Clearing Year to Date Issue Data""" D ^ASUUPLOG
S (ASUMY("E#","REQ"),ASUMY("E#","SSA"),ASUMY("E#","ACC"))=0
F S ASUMY("E#","REQ")=$O(^ASUMY(ASUMY("E#","REQ"))) Q:ASUMY("E#","REQ")'?1N.N K ^ASUMY(ASUMY("E#","REQ"))
Q
F S ASUMY("E#","REQ")=$O(^ASUMY(ASUMY("E#","REQ"))) Q:ASUMY("E#","REQ")'?1N.N D
.F S ASUMY("E#","SSA")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"))) Q:ASUMY("E#","SSA")'?1N.N D
..F S ASUMY("E#","ACC")=$O(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC"))) Q:ASUMY("E#","ACC")'?1N.N S ASUQ(1)="" D
...D READ^ASUMYDIO
...F S ASUQ(1)=$O(ASUMY("CMO",ASUQ(1))) Q:ASUQ(1)']"" S ASUQ(2)="" D
....F S ASUQ(2)=$O(ASUMY("CMO",ASUQ(1),ASUQ(2))) Q:ASUQ(2)']"" D
.....S ASUMY("CMO",ASUQ(1),ASUQ(2))=""
...F S ASUQ(1)=$O(ASUMY("YTD",ASUQ(1))) Q:ASUQ(1)']"" S ASUQ(2)="" D
....F S ASUQ(2)=$O(ASUMY("YTD",ASUQ(1),ASUQ(2))) Q:ASUQ(2)']"" D
.....S ASUMY("YTD",ASUQ(1),ASUQ(2))=""
...S (ASUMY("ISO","LI"),ASUMY("ISP","LI"),ASUMY("B/O","LI"),ASUMY("QTYADJ","LI"))=""
...S ASUMY("NOKL")=1 D WRITY^ASUMYDIO
..S ASUMY("E#","ACC")=0
.S ASUMY("E#","SSA")=0
K DR,DIE,DA,ASUMY,ASU
Q
ASUKPSYR ;
S ASURX="W !,""Clearing Issue Book Master""" D ^ASUUPLOG
S ASUMK("E#","STA")=0
F S ASUMK("E#","STA")=$O(^ASUMK(ASUMK("E#","STA"))) Q:ASUMK("E#","STA")'?1N.N D
.S ASUMK("E#","REQ")=0
.F S ASUMK("E#","REQ")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"))) Q:ASUMK("E#","REQ")'?1N.N D
..S ASUMK("E#","IDX")=0
..F S ASUMK("E#","IDX")=$O(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"),1,ASUMK("E#","IDX"))) Q:ASUMK("E#","IDX")'?1N.N D
...D READ^ASUMKBIO
...S ASUMK("PPY","VAL")=ASUMK("PFY","VAL")
...S ASUMK("PFY","VAL")=ASUMK("CFY","VAL")
...S ASUMK("CFY","VAL")=""
...S ASUMK("NOKL")=1 D EN1^ASUMKBIO
K ASUMK
Q
ASUMKBPS ; IHS/ITSC/LMH -UPDATE ISSUE BOOK MASTER ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility which is invoked to update the Issue Book
+3 ;Master file. The Issue Book master file is used to capture
+4 ;statistics concerning Issues.
+5 IF $GET(ASUT(ASUT,"B/O"))="B"&$GET(ASUT(ASUT,"FPN"))="N"
QUIT
+6 IF $EXTRACT(ASUT("TRCD"))=0
Begin DoDot:1
+7 SET ASUMK("E#","STA")=$GET(ASUT(ASUT,"PT","STA"))
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 SET ASUMK("E#","STA")=$GET(ASUMS("E#","STA"))
End DoDot:1
+10 SET ASUMK("E#","REQ")=ASUT(ASUT,"PT","REQ")
+11 ;Lookup STA in Issue Book Master
DO STA^ASUMKBIO(ASUMK("E#","STA"))
+12 IF Y<1
Begin DoDot:1
+13 IF Y=0
Begin DoDot:2
+14 ;Add STA to Issue Book master
DO ADDSTA^ASUMKBIO(ASUMK("E#","STA"))
+15 IF Y<0
Begin DoDot:3
+16 ;DFM P1 9/1/98
NEW Z
SET Z="Error adding STA : "_ASUMK("E#","STA")_" to YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=1
End DoDot:3
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 ;DFM P1 9/1/98
NEW Z
SET Z="Error finding STA : "_ASUMK("E#","STA")_" for YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=2
End DoDot:2
End DoDot:1
IF $DATA(DDSERROR)
QUIT
+19 ;Lookup REQ in Issue Book master
DO REQ^ASUMKBIO(ASUMK("E#","REQ"))
+20 IF Y<1
Begin DoDot:1
+21 IF Y=0
Begin DoDot:2
+22 ;Add REQ to Issue Book master
DO ADDREQ^ASUMKBIO(ASUMK("E#","REQ"))
+23 IF Y<0
Begin DoDot:3
+24 ;DFM P1 9/1/98
NEW Z
SET Z="Error adding REQ : "_ASUMK("E#","REQ")_" to YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=3
End DoDot:3
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 ;DFM P1 9/1/98
NEW Z
SET Z="Error finding REQ : "_ASUMK("E#","REQ")_" for YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=4
End DoDot:2
End DoDot:1
IF $DATA(DDSERROR)
QUIT
+27 IF ASUT("TYPE")=7
Begin DoDot:1
+28 SET ASUMX("E#","IDX")="99999999"
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 ;Lookup IDX in Issue Book master
DO IDX^ASUMKBIO(ASUMX("E#","IDX"))
End DoDot:1
+31 IF Y<1
Begin DoDot:1
+32 IF Y=0
Begin DoDot:2
+33 ;Add IDX to Issue Book master
DO ADDIDX^ASUMKBIO(ASUMK("E#","IDX"))
+34 IF Y<0
Begin DoDot:3
+35 ;DFM P1 9/1/98
NEW Z
SET Z="Error adding IDX : "_ASUMK("E#","IDX")_" to YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=5
End DoDot:3
End DoDot:2
+36 IF '$TEST
Begin DoDot:2
+37 ;DFM P1 9/1/98
NEW Z
SET Z="Error finding IDX : "_ASUMK("E#","IDX")_" for YTD DATA -RC : "_Y
WRITE *7
DO HLP^ASUJHELP(.Z)
SET DDSERROR=6
End DoDot:2
End DoDot:1
IF $DATA(DDSERROR)
QUIT
+38 ;Read Issue Book master into variables
DO READ^ASUMKBIO
+39 IF ASUT("TRCD")="5B"
Begin DoDot:1
+40 SET ASUMK("ULQTY")=$SELECT(ASUT(ASUT,"ULVQTY")=0:"",1:ASUT(ASUT,"ULVQTY"))
+41 SET ASUMK("PULQTY")=1
End DoDot:1
+42 IF '$TEST
Begin DoDot:1
+43 SET ASUV("MO")=+($PIECE(ASUT(ASUT,"VOU"),"-",2))
+44 IF ASUV("MO")']""
QUIT
+45 IF $EXTRACT(ASUT("TRCD"),2)?1A
Begin DoDot:2
+46 SET ASUMK(ASUV("MO"),"DOC")=$GET(ASUMK(ASUV("MO"),"DOC"))-1
+47 SET ASUMK(ASUV("MO"),"QTY")=$GET(ASUMK(ASUV("MO"),"QTY"))-ASUT(ASUT,"QTY","ISS")
+48 SET ASUMK("CFY","VAL")=$GET(ASUMK("CFY","VAL"))-(ASUT(ASUT,"VAL"))
End DoDot:2
+49 IF '$TEST
Begin DoDot:2
+50 IF ASUT("TRCD")'="31"
Begin DoDot:3
+51 SET ASUMK(ASUV("MO"),"DOC")=$GET(ASUMK(ASUV("MO"),"DOC"))+1
End DoDot:3
+52 SET ASUMK(ASUV("MO"),"QTY")=$GET(ASUMK(ASUV("MO"),"QTY"))+ASUT(ASUT,"QTY","ISS")
+53 SET ASUMK("CFY","VAL")=$GET(ASUMK("CFY","VAL"))+(ASUT(ASUT,"VAL"))
End DoDot:2
End DoDot:1
+54 DO EN1^ASUMKBIO
+55 QUIT
CLMO ;EP ;CLEAR MONTH
+1 SET ASUMK("MO")=ASUP("MO")+1
IF ASUMK("MO")=13
SET ASUMK("MO")=1
CLSM ;EP ;CLEAR PREVIOUSLY SELECTED MONTH
+1 SET (ASUMK("E#","STA"),ASUMK("E#","REQ"),ASUMK("E#","IDX"))=0
+2 FOR
SET ASUMK("E#","STA")=$ORDER(^ASUMK(ASUMK("E#","STA")))
IF ASUMK("E#","STA")'?1N.N
QUIT
Begin DoDot:1
+3 FOR
SET ASUMK("E#","REQ")=$ORDER(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ")))
IF ASUMK("E#","REQ")'?1N.N
QUIT
Begin DoDot:2
+4 FOR
SET ASUMK("E#","IDX")=$ORDER(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"),1,ASUMK("E#","IDX")))
IF ASUMK("E#","IDX")'?1N.N
QUIT
Begin DoDot:3
+5 DO READ^ASUMKBIO
+6 SET ASUMK(ASUMK("MO"),"DOC")=""
+7 SET ASUMK(ASUMK("MO"),"QTY")=""
+8 SET ASUMK("NOKL")=1
DO EN1^ASUMKBIO
End DoDot:3
+9 SET ASUMK("E#","IDX")=0
End DoDot:2
+10 SET ASUMK("E#","REQ")=0
SET ASUMK("E#","IDX")=0
End DoDot:1
+11 KILL ASUMK
+12 QUIT
CLYR ;EP; CLEAR YEARLY
+1 SET ASUP("CKY")=+$GET(ASUP("CKY"))
+2 DO DATE^ASUUDATE
DO TIME^ASUUDATE
+3 SET ASURX="W !,""S.A.M.S. Beginning of Year Update Procedure begun "_ASUK("DT","TIME")_""""
DO ^ASUUPLOG
+4 IF ASUP("CKY")=0
SET ASUP("CKY")=1
DO SETSY^ASUCOSTS
+5 IF ASUP("CKY")=1
DO ASUYPSYR
IF ASUP("HLT")
GOTO DONE
SET ASUP("CKY")=2
DO SETSY^ASUCOSTS
+6 IF ASUP("CKY")=2
DO ASUKPSYR
IF ASUP("HLT")
GOTO DONE
SET ASUP("CKY")=3
DO SETSY^ASUCOSTS
+7 IF ASUP("CKY")=3
Begin DoDot:1
+8 SET ASURX="W !,""Clearing Transaction History Files"""
DO ^ASUUPLOG
+9 DO EN2^ASU0PURG
End DoDot:1
IF ASUP("HLT")
GOTO DONE
SET ASUP("CKY")=4
DO SETSY^ASUCOSTS
+10 IF ASUP("CKY")=4
Begin DoDot:1
+11 SET ASUU("E#")=""
+12 FOR
SET ASUU("E#")=$ORDER(^ASUR1(ASUU("E#")))
IF ASUU("E#")=""
QUIT
IF ASUU("E#")="B"
QUIT
FOR ASUC("TR")=4,5,7,8,10,11,13,14,16,17,19,20
SET $PIECE(^ASUR1(ASUU("E#"),0),U,ASUC("TR"))=0
+13 KILL ASU
+14 SET ASUP("CKY")=5
DO SETSY^ASUCOSTS
End DoDot:1
+15 IF $GET(ASUP("HLT"))
QUIT
+16 DO TIME^ASUUDATE
+17 SET ASURX="W !,""S.A.M.S. Beginning of Year Update Procedure ended "_ASUK("DT","TIME")_""""
DO ^ASUUPLOG
+18 QUIT
DONE ;
+1 SET ASUP("HLT")=1
+2 QUIT
ASUYPSYR ;
+1 SET ASURX="W !,""Clearing Year to Date Issue Data"""
DO ^ASUUPLOG
+2 SET (ASUMY("E#","REQ"),ASUMY("E#","SSA"),ASUMY("E#","ACC"))=0
+3 FOR
SET ASUMY("E#","REQ")=$ORDER(^ASUMY(ASUMY("E#","REQ")))
IF ASUMY("E#","REQ")'?1N.N
QUIT
KILL ^ASUMY(ASUMY("E#","REQ"))
+4 QUIT
+5 FOR
SET ASUMY("E#","REQ")=$ORDER(^ASUMY(ASUMY("E#","REQ")))
IF ASUMY("E#","REQ")'?1N.N
QUIT
Begin DoDot:1
+6 FOR
SET ASUMY("E#","SSA")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA")))
IF ASUMY("E#","SSA")'?1N.N
QUIT
Begin DoDot:2
+7 FOR
SET ASUMY("E#","ACC")=$ORDER(^ASUMY(ASUMY("E#","REQ"),1,ASUMY("E#","SSA"),1,ASUMY("E#","ACC")))
IF ASUMY("E#","ACC")'?1N.N
QUIT
SET ASUQ(1)=""
Begin DoDot:3
+8 DO READ^ASUMYDIO
+9 FOR
SET ASUQ(1)=$ORDER(ASUMY("CMO",ASUQ(1)))
IF ASUQ(1)']""
QUIT
SET ASUQ(2)=""
Begin DoDot:4
+10 FOR
SET ASUQ(2)=$ORDER(ASUMY("CMO",ASUQ(1),ASUQ(2)))
IF ASUQ(2)']""
QUIT
Begin DoDot:5
+11 SET ASUMY("CMO",ASUQ(1),ASUQ(2))=""
End DoDot:5
End DoDot:4
+12 FOR
SET ASUQ(1)=$ORDER(ASUMY("YTD",ASUQ(1)))
IF ASUQ(1)']""
QUIT
SET ASUQ(2)=""
Begin DoDot:4
+13 FOR
SET ASUQ(2)=$ORDER(ASUMY("YTD",ASUQ(1),ASUQ(2)))
IF ASUQ(2)']""
QUIT
Begin DoDot:5
+14 SET ASUMY("YTD",ASUQ(1),ASUQ(2))=""
End DoDot:5
End DoDot:4
+15 SET (ASUMY("ISO","LI"),ASUMY("ISP","LI"),ASUMY("B/O","LI"),ASUMY("QTYADJ","LI"))=""
+16 SET ASUMY("NOKL")=1
DO WRITY^ASUMYDIO
End DoDot:3
+17 SET ASUMY("E#","ACC")=0
End DoDot:2
+18 SET ASUMY("E#","SSA")=0
End DoDot:1
+19 KILL DR,DIE,DA,ASUMY,ASU
+20 QUIT
ASUKPSYR ;
+1 SET ASURX="W !,""Clearing Issue Book Master"""
DO ^ASUUPLOG
+2 SET ASUMK("E#","STA")=0
+3 FOR
SET ASUMK("E#","STA")=$ORDER(^ASUMK(ASUMK("E#","STA")))
IF ASUMK("E#","STA")'?1N.N
QUIT
Begin DoDot:1
+4 SET ASUMK("E#","REQ")=0
+5 FOR
SET ASUMK("E#","REQ")=$ORDER(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ")))
IF ASUMK("E#","REQ")'?1N.N
QUIT
Begin DoDot:2
+6 SET ASUMK("E#","IDX")=0
+7 FOR
SET ASUMK("E#","IDX")=$ORDER(^ASUMK(ASUMK("E#","STA"),1,ASUMK("E#","REQ"),1,ASUMK("E#","IDX")))
IF ASUMK("E#","IDX")'?1N.N
QUIT
Begin DoDot:3
+8 DO READ^ASUMKBIO
+9 SET ASUMK("PPY","VAL")=ASUMK("PFY","VAL")
+10 SET ASUMK("PFY","VAL")=ASUMK("CFY","VAL")
+11 SET ASUMK("CFY","VAL")=""
+12 SET ASUMK("NOKL")=1
DO EN1^ASUMKBIO
End DoDot:3
End DoDot:2
End DoDot:1
+13 KILL ASUMK
+14 QUIT
