- 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
