ASUCOSTS ; IHS/ITSC/LMH -CLOSEOUT STATUS FUNCTIONS ; [ 07/26/2000 9:00 AM ]
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine provides entry points to store and print information
;concerning the status of an closeout.
;IHS/ITSC/MRS - Added lines 2 & 3 to HELP text so HELP+value will be correct 7/26/2000
D:$G(IOF)']"" HOME^%ZIS,^XBKVAR W @IOF,?25,"R U N S T A T U S R E P O R T I N G",!!
D EN2 W @IOF Q
EN2 ;EP ;
I $G(ASUP("CKP"))']"" D
.D SETCTRL
E D
.S ASUP("LSTY")=$G(ASUP("TYP"))
S ASUP("LSTN")=$S(ASUP("LSTY")=1:"monthly closeout",ASUP("LSTY")=2:"yearly closeout",1:"daily closeout")
W !!,"The status of the last closeout which was a '",ASUP("LSTN"),"' was : "
I ASUP("CKP")=0,ASUP("CKY")=0 D G PAUSE
.W !!?5,"Successfully completed."
E D
.W !!?5,$P($T(HELP+ASUP("CKP")),";",4) ; update status switch in ^AUSITE
.S ASUP=$P($T(HELP+ASUP("CKP")),";",5)
.I ASUP']"" W $P($T(HELP),";",4) Q
.I $G(ASUP(ASUP))']"" W $P($T(HELP),";",4) Q
.I ASUP="CKM" D
..W !?5,"Processing ended as "
..S X=""""_$P($T(CKM+ASUP("CKM")+1),";",4)
..I ASUP(ASUP)<9 D
...S X=X_""","" was processing."""
..E D
...S X=X_""","" was printing."""
.I ASUP="CKY" D
..W !?5,"Processing ended as "
..S X=""""_$P($T(CKM+ASUP("CKY")+1),";",4)_""","" being cleared."""
.I ASUP="CKX" D
..W !?5,"Processing ended as Report "
..S X=""""_$P($T(CKM+ASUP("CKX")+1),";",4)_""","" was sorting."""
.I ASUP="CKI" D
..W !?5,"Processing ended as Report "
..S X=""""_$P($T(CKM+ASUP("CKI")+1),";",4)_""","" was printing."""
.I ASUP="CKS" D
..I ASUP("CKS")=2!(ASUP("CKS")=3)!(ASUP("CKS")=17) D
...W !?5,"Processing ended as "
...S X=""""_$P($T(CKM+ASUP("CKS")+1),";",4)_""","" was processing"""
..E D
...W !?5,"Processing ended as Report "
...S X=""""_$P($T(CKM+ASUP("CKS")+1),";",4)_""","" was printing."""
.S X="W "_X X X
D RPTS
W !!,"If the problem causing processing to end has been addressed,"
W !,"the UPDATE RESTART option will start at that point and continue."
PAUSE ;
W !! N DIR S DIR(0)="E" D ^DIR Q
RPTS ;
W !
I ASUP("IVR")="Y" D
. W !?5,"Invoice Reports Printed"
E D
. W !?5,"Invoice Reports Did NOT Print"
I ASUP("STR")="Y" D
. W !?5,"Standard Reports Printed"
E D
. W !?5,"Standard Reports Did NOT Print"
Q
HELP ;;0;but NO FURTHUR HELP IS AVAILABLE.
;;1;Yearly Update was processing.;CKY
;;2;Report files cleared
;;3;Beginning balances obtained
;;4;Monthly Report Extracts were being created.;CKM
;;5;Report Extracts were being Sorted.;CKX
;;6;Invoices were printing.;CKI
;;7;Standard Reports were printing.;
;;8;Monthly Closeout was processing.;
;;9;Yearly Closeout was processing.;
;;10;Transacton count report was processing.;
;;11;Standard Monthly Reports were printing.;CKM
;;12;Standard Quarterly Reports were printing.;CKM
;;13;Standard Daily Reports were printing.;CKS
CKY ;;
;;1;Year to Date Issue data file was
;;2;Issue Book Master file was
;;3;Transaction History files were
;;4;Year to Date Counts in Report one were
CKM ;;
;;1;Extract for Data Center Processing
;;2;Extracting for Report 10V
;;3;Extracting for Report 12
;;4;Extracting for Report 13
;;5;Extracting for Report 15
;;6;Extracting for Report 16
;;7;Extracting for Report 17
;;8;Extracting for Report 23
;;9;Extracting for Report 24
;;10;Extracting for Report 74
;;11;Extracting for Report 77
;;12;Extracting for Report 78
;;13;Extracting for Report 79
;;14;Station Master PAMIQ and RPQ recalculating
;;15;Clear/Update YTD ISSUE DATA fields
;;16;Clear/Update ISSUE BOOK fields
;;17;Report 10V
;;18;Report 12
;;19;Report 13
;;20;Report 15
;;21;Report 16
;;22;Report 17
;;23;Report 23
;;24;Report 24
;;25;Report 74
;;26;Report 75
;;27;Report 77
;;28;Report 78
;;29;Report 79
;;30;Report 83
;;31;Report 25
;;32;Report 49
;;33;Report 81
;;34;Report 82
CKX ;;
;;1;01
;;2;03
;;3;04
;;4;05
;;5;06
;;6;07
;;7;7A
;;8;08
;;9;09
;;10;10A
;;11;10
;;12;11
;;13;13
;;14;70
;;15;71
;;16;72
;;17;73
;;18;74
;;19;76
;;20;79
;;21;83
CKI ;;
;;1;70
;;2;71
;;3;72
CKS ;;
;;1;1
;;2;as Monthly Closeout was processing.
;;3;as Yearly Closeout was processing.
;;4;3
;;5;4
;;6;5
;;7;6
;;8;7
;;9;7A
;;10;8
;;11;9
;;12;10A
;;13;10
;;14;11
;;15;13
;;16;73
;;17;as Monthly Reports were printing.
SETCTRL ;EP ;
S ASUP("HLT")=+$G(ASUP("HLT"))
F ASUP("LOOP")="7;MOE","8;MOW","9;MOL" D
.S ASUP($P(ASUP("LOOP"),";",2))=$P(^ASUSITE(1,2),U,$P(ASUP("LOOP"),";"))
F ASUP("LOOP")="2;LSTY","6;STD","7;IVD","10;AST","11;AIV","12;A13","13;LSDT","14;LSMO","15;LSYR" D
.S ASUP($P(ASUP("LOOP"),";",2))=$P(^ASUSITE(1,0),U,$P(ASUP("LOOP"),";"))
S X=$E(ASUP("LSMO"),1,2)*.01,X=X+.01,X=$P(X,".",2) S:X=1 X="10" S:X=13 X="01"
S ASUP("UPLD")=$P(^ASUSITE(1,1),U)
S ASUP("ARMS")=$P(^ASUSITE(1,3),U),ASUP("OLIB")=$P(^ASUSITE(1,3),U,5),ASUP("NXMO")=X,ASUP("MOW")=X_ASUP("MOW")
I ASUP("A13")=2 D
.S ASUD("R13","SEL")=$P(^ASUSITE(1,0),U,16)
.S ASUD("R13","RNG")=$P(^ASUSITE(1,0),U,17)
.I ASUD("R13","SEL")']"" K ASUD("R13","SEL") S ASUP("A13")=1
.I ASUD("R13","RNG")']"" K ASUD("R13","RNG") S ASUP("A13")=1
I ASUP("AST")<2,ASUP("STD")]"" D
.S ASUK("SRPT","IOP")=$P(ASUP("STD"),":")
.I ASUK("SRPT","IOP")="HFS" D
..S ASUP("STD","FIL")=$S($P(ASUP("STD"),":",2)]"":$P(ASUP("STD"),":",2),$G(ASUP("TYP"))=1:"ASUMR"_$G(ASUL(2,"STA","CD")),$G(ASUP("TYP"))=2:"ASUYR"_$G(ASUL(2,"STA","CD")),1:"ASUSR"_$G(ASUL(2,"STA","CD")))
..S ASUP("STD","EXT")=$S($P(ASUP("STD"),":",3)]"":$P(ASUP("STD"),":",3),1:$E(ASUK("DT","FM"),4,7))
..S ASUP("STD","DIR")=$S($P(ASUP("STD"),":",4)]"":$P(ASUP("STD"),":",4),1:"/usr/spool/uucppublic/")
..S X=""""_$G(ASUP("STD","DIR"))
..S X=X_$G(ASUP("STD","FIL"))
..S:$G(ASUP("STD","EXT"))]"" X=X_"."_ASUP("STD","EXT")
..S ASUK("SRPT","IOPAR")="("_X_""":""W"")"
..S ASUP("STD")=ASUK("SRPT","IOP")
I ASUP("AIV")<2,ASUP("IVD")]"" D
.S ASUK("IRPT","IOP")=$P(ASUP("IVD"),":")
.I ASUK("IRPT","IOP")="HFS" D
..S ASUP("IVD","FIL")=$S($P(ASUP("IVD"),":",2)]"":$P(ASUP("IVD"),":",2),1:"ASUIR"_$G(ASUL(2,"STA","CD")))
..S ASUP("IVD","EXT")=$S($P(ASUP("IVD"),":",3)]"":$P(ASUP("IVD"),":",3),1:$E(ASUK("DT","FM"),4,7))
..S ASUP("IVD","DIR")=$S($P(ASUP("IVD"),":",4)]"":$P(ASUP("IVD"),":",4),1:"/usr/spool/uucppublic/")
..S X=""""_$G(ASUP("IVD","DIR"))
..S X=X_$G(ASUP("IVD","FIL"))
..S:$G(ASUP("IVD","EXT"))]"" X=X_"."_ASUP("IVD","EXT")
..S ASUK("IRPT","IOPAR")="("_X_""":""W"")"
..S ASUP("IVD")=ASUK("IRPT","IOP")
GETSTAT ;EP ;
F ASUP("LOOP")="1;CKP","2;CKT","3;CKS","4;CKI","5;CKM","6;CKY","10;CKX" D
.S ASUP($P(ASUP("LOOP"),";",2))=$P(^ASUSITE(1,2),U,$P(ASUP("LOOP"),";"))
F ASUP("LOOP")="3;STR","4;IVR","5;STS" D
.S ASUP($P(ASUP("LOOP"),";",2))=$P(^ASUSITE(1,0),U,$P(ASUP("LOOP"),";"))
Q
SETSP ;EP ;UPDT
S $P(^ASUSITE(1,2),U)=ASUP("CKP") Q
SETST ;EP ;TRNS
S $P(^ASUSITE(1,2),U,2)=ASUP("CKT") Q
SETSS ;EP ;STNDRD
S $P(^ASUSITE(1,2),U,3)=ASUP("CKS"),$P(^ASUSITE(1,0),U,3)=ASUP("STR") Q
SETSI ;EP ;INV
S $P(^ASUSITE(1,2),U,4)=ASUP("CKI"),$P(^ASUSITE(1,0),U,4)=ASUP("IVR") Q
SETSM ;EP ;MTHLY
S $P(^ASUSITE(1,2),U,5)=ASUP("CKM") Q
SETSX ;EP ;RPTXTR
S $P(^ASUSITE(1,2),U,10)=ASUP("CKX") Q
SETSY ;EP ;YR
S $P(^ASUSITE(1,2),U,6)=ASUP("CKY") Q
SETTY ;EP ;TYP
S $P(^ASUSITE(1,0),U,2)=ASUP("TYP")
S (ASUP("STR"),ASUP("STS"),ASUP("IVR"))="N"
SETS ;EP ;
F ASUP("LOOP")="3;STR","4;IVR","5;STS" D
.S $P(^ASUSITE(1,0),U,$P(ASUP("LOOP"),";"))=ASUP($P(ASUP("LOOP"),";",2))
Q
SETSTA ;EP ;STAT
S $P(^ASUSITE(1,0),U,5)=ASUP("STS") Q
SETLD ;EP ;LAST UPDATE
S $P(^ASUSITE(1,0),U,13)=ASUP("LSDT") Q
SETLM ;EP ;LAST MTH
S $P(^ASUSITE(1,0),U,14)=ASUP("LSMO") Q
SETLY ;EP ; LAST YR
S $P(^ASUSITE(1,0),U,15)=ASUP("LSYR") Q
SETSTAT ;EP ;
F ASUP("LOOP")="1;CKP","2;CKT","3;CKS","4;CKI","5;CKM","6;CKY","10;CKX" D
.S $P(^ASUSITE(1,2),U,$P(ASUP("LOOP"),";"))=ASUP($P(ASUP("LOOP"),";",2))
D SETS I $G(ASUP("HLT"))=1 Q
S ASUP("LSDT")=ASUK("DT","FM")
F ASUP("LOOP")="13;LSDT","14;LSMO","15;LSYR" D
.S $P(^ASUSITE(1,0),U,$P(ASUP("LOOP"),";"))=ASUP($P(ASUP("LOOP"),";",2))
Q
ASUCOSTS ; IHS/ITSC/LMH -CLOSEOUT STATUS FUNCTIONS ; [ 07/26/2000 9:00 AM ]
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine provides entry points to store and print information
+3 ;concerning the status of an closeout.
+4 ;IHS/ITSC/MRS - Added lines 2 & 3 to HELP text so HELP+value will be correct 7/26/2000
+5 IF $GET(IOF)']""
DO HOME^%ZIS
DO ^XBKVAR
WRITE @IOF,?25,"R U N S T A T U S R E P O R T I N G",!!
+6 DO EN2
WRITE @IOF
QUIT
EN2 ;EP ;
+1 IF $GET(ASUP("CKP"))']""
Begin DoDot:1
+2 DO SETCTRL
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET ASUP("LSTY")=$GET(ASUP("TYP"))
End DoDot:1
+5 SET ASUP("LSTN")=$SELECT(ASUP("LSTY")=1:"monthly closeout",ASUP("LSTY")=2:"yearly closeout",1:"daily closeout")
+6 WRITE !!,"The status of the last closeout which was a '",ASUP("LSTN"),"' was : "
+7 IF ASUP("CKP")=0
IF ASUP("CKY")=0
Begin DoDot:1
+8 WRITE !!?5,"Successfully completed."
End DoDot:1
GOTO PAUSE
+9 IF '$TEST
Begin DoDot:1
+10 ; update status switch in ^AUSITE
WRITE !!?5,$PIECE($TEXT(HELP+ASUP("CKP")),";",4)
+11 SET ASUP=$PIECE($TEXT(HELP+ASUP("CKP")),";",5)
+12 IF ASUP']""
WRITE $PIECE($TEXT(HELP),";",4)
QUIT
+13 IF $GET(ASUP(ASUP))']""
WRITE $PIECE($TEXT(HELP),";",4)
QUIT
+14 IF ASUP="CKM"
Begin DoDot:2
+15 WRITE !?5,"Processing ended as "
+16 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKM")+1),";",4)
+17 IF ASUP(ASUP)<9
Begin DoDot:3
+18 SET X=X_""","" was processing."""
End DoDot:3
+19 IF '$TEST
Begin DoDot:3
+20 SET X=X_""","" was printing."""
End DoDot:3
End DoDot:2
+21 IF ASUP="CKY"
Begin DoDot:2
+22 WRITE !?5,"Processing ended as "
+23 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKY")+1),";",4)_""","" being cleared."""
End DoDot:2
+24 IF ASUP="CKX"
Begin DoDot:2
+25 WRITE !?5,"Processing ended as Report "
+26 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKX")+1),";",4)_""","" was sorting."""
End DoDot:2
+27 IF ASUP="CKI"
Begin DoDot:2
+28 WRITE !?5,"Processing ended as Report "
+29 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKI")+1),";",4)_""","" was printing."""
End DoDot:2
+30 IF ASUP="CKS"
Begin DoDot:2
+31 IF ASUP("CKS")=2!(ASUP("CKS")=3)!(ASUP("CKS")=17)
Begin DoDot:3
+32 WRITE !?5,"Processing ended as "
+33 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKS")+1),";",4)_""","" was processing"""
End DoDot:3
+34 IF '$TEST
Begin DoDot:3
+35 WRITE !?5,"Processing ended as Report "
+36 SET X=""""_$PIECE($TEXT(CKM+ASUP("CKS")+1),";",4)_""","" was printing."""
End DoDot:3
End DoDot:2
+37 SET X="W "_X
XECUTE X
End DoDot:1
+38 DO RPTS
+39 WRITE !!,"If the problem causing processing to end has been addressed,"
+40 WRITE !,"the UPDATE RESTART option will start at that point and continue."
PAUSE ;
+1 WRITE !!
NEW DIR
SET DIR(0)="E"
DO ^DIR
QUIT
RPTS ;
+1 WRITE !
+2 IF ASUP("IVR")="Y"
Begin DoDot:1
+3 WRITE !?5,"Invoice Reports Printed"
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 WRITE !?5,"Invoice Reports Did NOT Print"
End DoDot:1
+6 IF ASUP("STR")="Y"
Begin DoDot:1
+7 WRITE !?5,"Standard Reports Printed"
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 WRITE !?5,"Standard Reports Did NOT Print"
End DoDot:1
+10 QUIT
HELP ;;0;but NO FURTHUR HELP IS AVAILABLE.
+1 ;;1;Yearly Update was processing.;CKY
+2 ;;2;Report files cleared
+3 ;;3;Beginning balances obtained
+4 ;;4;Monthly Report Extracts were being created.;CKM
+5 ;;5;Report Extracts were being Sorted.;CKX
+6 ;;6;Invoices were printing.;CKI
+7 ;;7;Standard Reports were printing.;
+8 ;;8;Monthly Closeout was processing.;
+9 ;;9;Yearly Closeout was processing.;
+10 ;;10;Transacton count report was processing.;
+11 ;;11;Standard Monthly Reports were printing.;CKM
+12 ;;12;Standard Quarterly Reports were printing.;CKM
+13 ;;13;Standard Daily Reports were printing.;CKS
CKY ;;
+1 ;;1;Year to Date Issue data file was
+2 ;;2;Issue Book Master file was
+3 ;;3;Transaction History files were
+4 ;;4;Year to Date Counts in Report one were
CKM ;;
+1 ;;1;Extract for Data Center Processing
+2 ;;2;Extracting for Report 10V
+3 ;;3;Extracting for Report 12
+4 ;;4;Extracting for Report 13
+5 ;;5;Extracting for Report 15
+6 ;;6;Extracting for Report 16
+7 ;;7;Extracting for Report 17
+8 ;;8;Extracting for Report 23
+9 ;;9;Extracting for Report 24
+10 ;;10;Extracting for Report 74
+11 ;;11;Extracting for Report 77
+12 ;;12;Extracting for Report 78
+13 ;;13;Extracting for Report 79
+14 ;;14;Station Master PAMIQ and RPQ recalculating
+15 ;;15;Clear/Update YTD ISSUE DATA fields
+16 ;;16;Clear/Update ISSUE BOOK fields
+17 ;;17;Report 10V
+18 ;;18;Report 12
+19 ;;19;Report 13
+20 ;;20;Report 15
+21 ;;21;Report 16
+22 ;;22;Report 17
+23 ;;23;Report 23
+24 ;;24;Report 24
+25 ;;25;Report 74
+26 ;;26;Report 75
+27 ;;27;Report 77
+28 ;;28;Report 78
+29 ;;29;Report 79
+30 ;;30;Report 83
+31 ;;31;Report 25
+32 ;;32;Report 49
+33 ;;33;Report 81
+34 ;;34;Report 82
CKX ;;
+1 ;;1;01
+2 ;;2;03
+3 ;;3;04
+4 ;;4;05
+5 ;;5;06
+6 ;;6;07
+7 ;;7;7A
+8 ;;8;08
+9 ;;9;09
+10 ;;10;10A
+11 ;;11;10
+12 ;;12;11
+13 ;;13;13
+14 ;;14;70
+15 ;;15;71
+16 ;;16;72
+17 ;;17;73
+18 ;;18;74
+19 ;;19;76
+20 ;;20;79
+21 ;;21;83
CKI ;;
+1 ;;1;70
+2 ;;2;71
+3 ;;3;72
CKS ;;
+1 ;;1;1
+2 ;;2;as Monthly Closeout was processing.
+3 ;;3;as Yearly Closeout was processing.
+4 ;;4;3
+5 ;;5;4
+6 ;;6;5
+7 ;;7;6
+8 ;;8;7
+9 ;;9;7A
+10 ;;10;8
+11 ;;11;9
+12 ;;12;10A
+13 ;;13;10
+14 ;;14;11
+15 ;;15;13
+16 ;;16;73
+17 ;;17;as Monthly Reports were printing.
SETCTRL ;EP ;
+1 SET ASUP("HLT")=+$GET(ASUP("HLT"))
+2 FOR ASUP("LOOP")="7;MOE","8;MOW","9;MOL"
Begin DoDot:1
+3 SET ASUP($PIECE(ASUP("LOOP"),";",2))=$PIECE(^ASUSITE(1,2),U,$PIECE(ASUP("LOOP"),";"))
End DoDot:1
+4 FOR ASUP("LOOP")="2;LSTY","6;STD","7;IVD","10;AST","11;AIV","12;A13","13;LSDT","14;LSMO","15;LSYR"
Begin DoDot:1
+5 SET ASUP($PIECE(ASUP("LOOP"),";",2))=$PIECE(^ASUSITE(1,0),U,$PIECE(ASUP("LOOP"),";"))
End DoDot:1
+6 SET X=$EXTRACT(ASUP("LSMO"),1,2)*.01
SET X=X+.01
SET X=$PIECE(X,".",2)
IF X=1
SET X="10"
IF X=13
SET X="01"
+7 SET ASUP("UPLD")=$PIECE(^ASUSITE(1,1),U)
+8 SET ASUP("ARMS")=$PIECE(^ASUSITE(1,3),U)
SET ASUP("OLIB")=$PIECE(^ASUSITE(1,3),U,5)
SET ASUP("NXMO")=X
SET ASUP("MOW")=X_ASUP("MOW")
+9 IF ASUP("A13")=2
Begin DoDot:1
+10 SET ASUD("R13","SEL")=$PIECE(^ASUSITE(1,0),U,16)
+11 SET ASUD("R13","RNG")=$PIECE(^ASUSITE(1,0),U,17)
+12 IF ASUD("R13","SEL")']""
KILL ASUD("R13","SEL")
SET ASUP("A13")=1
+13 IF ASUD("R13","RNG")']""
KILL ASUD("R13","RNG")
SET ASUP("A13")=1
End DoDot:1
+14 IF ASUP("AST")<2
IF ASUP("STD")]""
Begin DoDot:1
+15 SET ASUK("SRPT","IOP")=$PIECE(ASUP("STD"),":")
+16 IF ASUK("SRPT","IOP")="HFS"
Begin DoDot:2
+17 SET ASUP("STD","FIL")=$SELECT($PIECE(ASUP("STD"),":",2)]"":$PIECE(ASUP("STD"),":",2),$GET(ASUP("TYP"))=1:"ASUMR"_$GET(ASUL(2,"STA","CD")),$GET(ASUP("TYP"))=2:"ASUYR"_$GET(ASUL(2,"STA","CD")),1:"ASUSR"_$GET(ASUL(2,"STA","CD")
))
+18 SET ASUP("STD","EXT")=$SELECT($PIECE(ASUP("STD"),":",3)]"":$PIECE(ASUP("STD"),":",3),1:$EXTRACT(ASUK("DT","FM"),4,7))
+19 SET ASUP("STD","DIR")=$SELECT($PIECE(ASUP("STD"),":",4)]"":$PIECE(ASUP("STD"),":",4),1:"/usr/spool/uucppublic/")
+20 SET X=""""_$GET(ASUP("STD","DIR"))
+21 SET X=X_$GET(ASUP("STD","FIL"))
+22 IF $GET(ASUP("STD","EXT"))]""
SET X=X_"."_ASUP("STD","EXT")
+23 SET ASUK("SRPT","IOPAR")="("_X_""":""W"")"
+24 SET ASUP("STD")=ASUK("SRPT","IOP")
End DoDot:2
End DoDot:1
+25 IF ASUP("AIV")<2
IF ASUP("IVD")]""
Begin DoDot:1
+26 SET ASUK("IRPT","IOP")=$PIECE(ASUP("IVD"),":")
+27 IF ASUK("IRPT","IOP")="HFS"
Begin DoDot:2
+28 SET ASUP("IVD","FIL")=$SELECT($PIECE(ASUP("IVD"),":",2)]"":$PIECE(ASUP("IVD"),":",2),1:"ASUIR"_$GET(ASUL(2,"STA","CD")))
+29 SET ASUP("IVD","EXT")=$SELECT($PIECE(ASUP("IVD"),":",3)]"":$PIECE(ASUP("IVD"),":",3),1:$EXTRACT(ASUK("DT","FM"),4,7))
+30 SET ASUP("IVD","DIR")=$SELECT($PIECE(ASUP("IVD"),":",4)]"":$PIECE(ASUP("IVD"),":",4),1:"/usr/spool/uucppublic/")
+31 SET X=""""_$GET(ASUP("IVD","DIR"))
+32 SET X=X_$GET(ASUP("IVD","FIL"))
+33 IF $GET(ASUP("IVD","EXT"))]""
SET X=X_"."_ASUP("IVD","EXT")
+34 SET ASUK("IRPT","IOPAR")="("_X_""":""W"")"
+35 SET ASUP("IVD")=ASUK("IRPT","IOP")
End DoDot:2
End DoDot:1
GETSTAT ;EP ;
+1 FOR ASUP("LOOP")="1;CKP","2;CKT","3;CKS","4;CKI","5;CKM","6;CKY","10;CKX"
Begin DoDot:1
+2 SET ASUP($PIECE(ASUP("LOOP"),";",2))=$PIECE(^ASUSITE(1,2),U,$PIECE(ASUP("LOOP"),";"))
End DoDot:1
+3 FOR ASUP("LOOP")="3;STR","4;IVR","5;STS"
Begin DoDot:1
+4 SET ASUP($PIECE(ASUP("LOOP"),";",2))=$PIECE(^ASUSITE(1,0),U,$PIECE(ASUP("LOOP"),";"))
End DoDot:1
+5 QUIT
SETSP ;EP ;UPDT
+1 SET $PIECE(^ASUSITE(1,2),U)=ASUP("CKP")
QUIT
SETST ;EP ;TRNS
+1 SET $PIECE(^ASUSITE(1,2),U,2)=ASUP("CKT")
QUIT
SETSS ;EP ;STNDRD
+1 SET $PIECE(^ASUSITE(1,2),U,3)=ASUP("CKS")
SET $PIECE(^ASUSITE(1,0),U,3)=ASUP("STR")
QUIT
SETSI ;EP ;INV
+1 SET $PIECE(^ASUSITE(1,2),U,4)=ASUP("CKI")
SET $PIECE(^ASUSITE(1,0),U,4)=ASUP("IVR")
QUIT
SETSM ;EP ;MTHLY
+1 SET $PIECE(^ASUSITE(1,2),U,5)=ASUP("CKM")
QUIT
SETSX ;EP ;RPTXTR
+1 SET $PIECE(^ASUSITE(1,2),U,10)=ASUP("CKX")
QUIT
SETSY ;EP ;YR
+1 SET $PIECE(^ASUSITE(1,2),U,6)=ASUP("CKY")
QUIT
SETTY ;EP ;TYP
+1 SET $PIECE(^ASUSITE(1,0),U,2)=ASUP("TYP")
+2 SET (ASUP("STR"),ASUP("STS"),ASUP("IVR"))="N"
SETS ;EP ;
+1 FOR ASUP("LOOP")="3;STR","4;IVR","5;STS"
Begin DoDot:1
+2 SET $PIECE(^ASUSITE(1,0),U,$PIECE(ASUP("LOOP"),";"))=ASUP($PIECE(ASUP("LOOP"),";",2))
End DoDot:1
+3 QUIT
SETSTA ;EP ;STAT
+1 SET $PIECE(^ASUSITE(1,0),U,5)=ASUP("STS")
QUIT
SETLD ;EP ;LAST UPDATE
+1 SET $PIECE(^ASUSITE(1,0),U,13)=ASUP("LSDT")
QUIT
SETLM ;EP ;LAST MTH
+1 SET $PIECE(^ASUSITE(1,0),U,14)=ASUP("LSMO")
QUIT
SETLY ;EP ; LAST YR
+1 SET $PIECE(^ASUSITE(1,0),U,15)=ASUP("LSYR")
QUIT
SETSTAT ;EP ;
+1 FOR ASUP("LOOP")="1;CKP","2;CKT","3;CKS","4;CKI","5;CKM","6;CKY","10;CKX"
Begin DoDot:1
+2 SET $PIECE(^ASUSITE(1,2),U,$PIECE(ASUP("LOOP"),";"))=ASUP($PIECE(ASUP("LOOP"),";",2))
End DoDot:1
+3 DO SETS
IF $GET(ASUP("HLT"))=1
QUIT
+4 SET ASUP("LSDT")=ASUK("DT","FM")
+5 FOR ASUP("LOOP")="13;LSDT","14;LSMO","15;LSYR"
Begin DoDot:1
+6 SET $PIECE(^ASUSITE(1,0),U,$PIECE(ASUP("LOOP"),";"))=ASUP($PIECE(ASUP("LOOP"),";",2))
End DoDot:1
+7 QUIT
