ASUW2SAM.m

ASUW2SAM ; IHS/ITSC/LMH - UPLOAD TO HEADQUARTERS ; 

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

MO(X) ;EP ;UPLOAD FOR MONTH IN X

 S ASUP("MO")=X

 D:$G(ASUP("MOE"))']"" SETCTRL^ASUCOSTS

 D:$G(ASUP("MOYR"))']"" SETMO^ASUUDATE(X)

 D TIME^ASUUDATE

 S ASUW("DT EXT")=ASUK("DT","FM")

 S ASURX="W !,""S.A.M.S. Upload data for SAMS Procedure Begun "_ASUK("DT","TIME")_"""" D ^ASUUPLOG

 S ASUW("TY RUN")=^ASUSITE(1,0)

 K ^XTMP("ASUW") S ASUHDA="",^XTMP("ASUW",0)=ASUK("DT","FM")_U_ASUK("DT","FM")+100000

 F  S ASUHDA=$O(^ASUH("C","U",ASUHDA)) Q:ASUHDA'?1N.N  D

 .M ^XTMP("ASUW","H",ASUHDA)=^ASUH(ASUHDA)

 .Q:ASUP("UPLD")=3

 .D UPDTHIST ;DFM P1 8/28/98

 D LOGNTRY(ASUP("MO"))

 D TIME^ASUUDATE

 S ASURX="W !,""S.A.M.S. Upload data for SAMS Procedure Ended "_ASUK("DT","TIME")_"""" D ^ASUUPLOG

 Q

UPDTHIST ;EP ;Update History record as extracted SUBROUTINE ADDED ;DFM P1 8/28/98

 S DA=ASUHDA,DIE="^ASUH(" ;DFM P1 8/28/98

 S DR=".09///"_ASUW("DT EXT")_";.1///X" D ^DIE ;DFM P1 8/28/98

 Q  ;DFM P1 8/28/98

LOGNTRY(X) ;EP ;Enter extract data in Log master

 S ASUP("MO")=X

 K DD,D0

 I '$D(ASUP("QTR")) D SETQTR^ASUUDATE

 S ASUW("LOG","DT")=$S($L(X)=1:"0"_X,1:X)_"/00/"_$E(ASUK("DT","FM"),2,3)

 S ASURX="W !,""Run Month="_X_" Run Quarter="_ASUP("QTR")_" Log Date="_ASUW("LOG","DT")_"""" D ^ASUUPLOG

 ;begin Y2K

 ;S ASUW("LOG","KY")=$S(ASUP("YR")<98:2,1:3)_ASUP("YR")_$E(ASUP("MOYR"),1,2)_"00"

 S X=ASUP("MOYR")        ;Y2000

 D START^ASUUY2K(.X,1,U,"N")  ;Y2000

 S:$E(X,3,4)="00" $E(X,3,4)=$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(X,1,2)) ;*** TESTING - AEF *** TO PUT A DAY IN THE DATE SO THAT FILEMAN22 WILL ACCEPT IT

 S ASUW("LOG","KY")=X    ;Y2000

 ;end Y2K

 K DIC,DD,DO

 S DIC="^ASUML(",DIC(0)="LZM",X=ASUW("LOG","KY")

 S DIC("DR")=".01///"_ASUW("LOG","KY")_";.02///"_ASUL(1,"AR","AP")_";2///"_ASUP("QTR")

 D FILE^DICN

 I +Y<0 D

 .S ASURX="W !,""Add New Months entry to Extract Log file unsucessful - "",Y,!"

 .D ^ASUUPLOG Q

 E  D

 .S ASUW("DA")=+Y

 .I '$D(^ASUML(ASUW("DA"),1,0)) S ^ASUML(ASUW("DA"),1,0)="^9002039.981DA^0^"

 .S ASUW("DA",1)=$O(^ASUML(ASUW("DA"),"B",ASUK("DT","FM"),""))

 .I ASUW("DA",1)']"" D

 ..S ASUW("DA",1)=$P(^ASUML(ASUW("DA"),1,0),U,3)+1

 ..S $P(^ASUML(ASUW("DA"),1,0),U,3)=ASUW("DA",1)

 ..S $P(^ASUML(ASUW("DA"),1,0),U,4)=$P(^ASUML(ASUW("DA"),1,0),U,4)+1

 ..S ^ASUML(ASUW("DA"),"B",ASUK("DT","FM"),ASUW("DA",1))=""

 .F X=1:1:7 I '$D(ASUC(X)) S ASUC(X)=""

 .S ^ASUML(ASUW("DA"),1,ASUW("DA",1),0)=ASUK("DT","FM")_U_ASUC(1)_U_ASUC(2)_U_ASUC(3)_U_ASUC(4)_U_ASUC(5)_U_ASUC(6)_U_ASUC(7)

 .I Y<0 S ASURX="W !,""Add New Extract Date to Extract Log file unsucessful"",!" D ^ASUUPLOG Q

 .S ASURX="W !,""Entry to Extract Log file made"",!" D ^ASUUPLOG

 K ASUW("LOG","DT"),ASUW("DA"),X,Y

 Q

ASUW2SAM  ; IHS/ITSC/LMH - UPLOAD TO HEADQUARTERS ; 

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

MO(X)     ;EP ;UPLOAD FOR MONTH IN X

 +1        SET ASUP("MO")=X

 +2        IF $GET(ASUP("MOE"))']""

               DO SETCTRL^ASUCOSTS

 +3        IF $GET(ASUP("MOYR"))']""

               DO SETMO^ASUUDATE(X)

 +4        DO TIME^ASUUDATE

 +5        SET ASUW("DT EXT")=ASUK("DT","FM")

 +6        SET ASURX="W !,""S.A.M.S. Upload data for SAMS Procedure Begun "_ASUK("DT","TIME")_""""

           DO ^ASUUPLOG

 +7        SET ASUW("TY RUN")=^ASUSITE(1,0)

 +8        KILL ^XTMP("ASUW")

           SET ASUHDA=""

           SET ^XTMP("ASUW",0)=ASUK("DT","FM")_U_ASUK("DT","FM")+100000

 +9        FOR 

               SET ASUHDA=$ORDER(^ASUH("C","U",ASUHDA))

               IF ASUHDA'?1N.N

                   QUIT 

               Begin DoDot:1

 +10               MERGE ^XTMP("ASUW","H",ASUHDA)=^ASUH(ASUHDA)

 +11               IF ASUP("UPLD")=3

                       QUIT 

 +12      ;DFM P1 8/28/98

                   DO UPDTHIST

               End DoDot:1

 +13       DO LOGNTRY(ASUP("MO"))

 +14       DO TIME^ASUUDATE

 +15       SET ASURX="W !,""S.A.M.S. Upload data for SAMS Procedure Ended "_ASUK("DT","TIME")_""""

           DO ^ASUUPLOG

 +16       QUIT 

UPDTHIST  ;EP ;Update History record as extracted SUBROUTINE ADDED ;DFM P1 8/28/98

 +1       ;DFM P1 8/28/98

           SET DA=ASUHDA

           SET DIE="^ASUH("

 +2       ;DFM P1 8/28/98

           SET DR=".09///"_ASUW("DT EXT")_";.1///X"

           DO ^DIE

 +3       ;DFM P1 8/28/98

           QUIT 

LOGNTRY(X) ;EP ;Enter extract data in Log master

 +1        SET ASUP("MO")=X

 +2        KILL DD,D0

 +3        IF '$DATA(ASUP("QTR"))

               DO SETQTR^ASUUDATE

 +4        SET ASUW("LOG","DT")=$SELECT($LENGTH(X)=1:"0"_X,1:X)_"/00/"_$EXTRACT(ASUK("DT","FM"),2,3)

 +5        SET ASURX="W !,""Run Month="_X_" Run Quarter="_ASUP("QTR")_" Log Date="_ASUW("LOG","DT")_""""

           DO ^ASUUPLOG

 +6       ;begin Y2K

 +7       ;S ASUW("LOG","KY")=$S(ASUP("YR")<98:2,1:3)_ASUP("YR")_$E(ASUP("MOYR"),1,2)_"00"

 +8       ;Y2000

           SET X=ASUP("MOYR")

 +9       ;Y2000

           DO START^ASUUY2K(.X,1,U,"N")

 +10      ;*** TESTING - AEF *** TO PUT A DAY IN THE DATE SO THAT FILEMAN22 WILL ACCEPT IT

           IF $EXTRACT(X,3,4)="00"

               SET $EXTRACT(X,3,4)=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31",U,+$EXTRACT(X,1,2))

 +11      ;Y2000

           SET ASUW("LOG","KY")=X

 +12      ;end Y2K

 +13       KILL DIC,DD,DO

 +14       SET DIC="^ASUML("

           SET DIC(0)="LZM"

           SET X=ASUW("LOG","KY")

 +15       SET DIC("DR")=".01///"_ASUW("LOG","KY")_";.02///"_ASUL(1,"AR","AP")_";2///"_ASUP("QTR")

 +16       DO FILE^DICN

 +17       IF +Y<0

               Begin DoDot:1

 +18               SET ASURX="W !,""Add New Months entry to Extract Log file unsucessful - "",Y,!"

 +19               DO ^ASUUPLOG

                   QUIT 

               End DoDot:1

 +20      IF '$TEST

               Begin DoDot:1

 +21               SET ASUW("DA")=+Y

 +22               IF '$DATA(^ASUML(ASUW("DA"),1,0))

                       SET ^ASUML(ASUW("DA"),1,0)="^9002039.981DA^0^"

 +23               SET ASUW("DA",1)=$ORDER(^ASUML(ASUW("DA"),"B",ASUK("DT","FM"),""))

 +24               IF ASUW("DA",1)']""

                       Begin DoDot:2

 +25                       SET ASUW("DA",1)=$PIECE(^ASUML(ASUW("DA"),1,0),U,3)+1

 +26                       SET $PIECE(^ASUML(ASUW("DA"),1,0),U,3)=ASUW("DA",1)

 +27                       SET $PIECE(^ASUML(ASUW("DA"),1,0),U,4)=$PIECE(^ASUML(ASUW("DA"),1,0),U,4)+1

 +28                       SET ^ASUML(ASUW("DA"),"B",ASUK("DT","FM"),ASUW("DA",1))=""

                       End DoDot:2

 +29               FOR X=1:1:7

                       IF '$DATA(ASUC(X))

                           SET ASUC(X)=""

 +30               SET ^ASUML(ASUW("DA"),1,ASUW("DA",1),0)=ASUK("DT","FM")_U_ASUC(1)_U_ASUC(2)_U_ASUC(3)_U_ASUC(4)_U_ASUC(5)_U_ASUC(6)_U_ASUC(7)

 +31               IF Y<0

                       SET ASURX="W !,""Add New Extract Date to Extract Log file unsucessful"",!"

                       DO ^ASUUPLOG

                       QUIT 

 +32               SET ASURX="W !,""Entry to Extract Log file made"",!"

                   DO ^ASUUPLOG

               End DoDot:1

 +33       KILL ASUW("LOG","DT"),ASUW("DA"),X,Y

 +34       QUIT