AFSLLDO1 ;IHS/OIRM/DSD/JDM - LOAD ODF FROM DOWNLOAD FILE; [ 10/27/2004 4:21 PM ]
;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
;;ACR*2.1*9 MODIFIED FOR CACHE' COMPLIANCE
;Module to display message, find the file and continue
INFO D ^XBCLS,CRTSETUP^AFSLCRTS S AFSLFFND=0 D NOW^%DTC S AFSLDT=$P(%,".",1) K %,%H,%I,X
D SETTBL
S DY=2,DX=20 X XY W @AFSLRVON,"IHS 1166 APPROVALS FOR PAYMENT SYSTEM",@AFSLRVOF
S DY=3,DX=19 X XY W @AFSLRVON,"IMPORT H.A.S. OBLIGATIONS DOWNLOAD FILE",@AFSLRVOF
S DY=4,DX=2 X XY W @AFSLRVON," ",@AFSLRVOF
S DX=12
S DY=6 X XY W "This import process will completely replace all data"
S DY=7 X XY W "currently stored in your local obligations document"
S DY=8 X XY W "file with the current obligations data on file in the"
S DY=9 X XY W "Health Accounting System at Parklawn Computer Center."
S DY=11 X XY W "There should have been NO payment data entered into"
S DY=12 X XY W "the IHS 1166 APPROVALS FOR PAYMENT system since the"
S DY=13 X XY W "last DHR Data Entry splitout & transmission to PCC."
S DY=14 X XY W "Otherwise, that data must be re-entered after this"
S DY=15 X XY W "import process is completed. IT IS RECOMMENDED THAT"
S DY=16 X XY W "YOU REQUEST YOUR ADP SITE MANAGER SAVE THE GLOBAL"
S DY=17 X XY W "^AFSLODOC BEFORE YOU CONTINUE WITH THIS PROCESS."
S DY=18,DX=2 X XY W @AFSLRVON," ",@AFSLRVOF
;S DY=23,DX=18 X XY R "CONTINUE (Y/N) N//",AFSLCONT:300 ;ACR*2.1*13.02 IM13574
;I AFSLCONT'="Y"&(AFSLCONT'="y") D VKILL Q ; ACR*2.1*13.02 IM13574
D PAUSE^ACRFWARN ;ACR*2.1*13.02 IM13574
I ($G(ACRY)=0)!($D(ACRQUIT))!($D(ACROUT)) D VKILL Q ;ACR*2.1*13.02 IM13574
S AFSLCONT=$S(ACRY=1:"Y",1:"N") ;ACR*2.1*13.02 IM13574
SELECT ;
D ^AFSLHASL
I AFSLCONT'="Y"&(AFSLCONT'="y") D VKILL Q
F I=19:1:23 S DY=I,DX=1 U IO(0) X XY W $J("",80)
;S DY=20,DX=12 X XY W @AFSLRVON,"LOOKING FOR FILE:",@AFSLRVOF," "_AFSLIDIR_"/",%FN ;ACR*2.1*13.06 IM14144
S DY=20,DX=12 X XY W @AFSLRVON,"LOOKING FOR FILE:",@AFSLRVOF," "_AFSLIDIR,%FN ;ACR*2.1*13.06 IM14144
;
N ARMSDIR ;ACR*2.1*13.06 IM14144
S ARMSDIR=$$ARMSDIR^ACRFSYS(1) ;ACR*2.1*13.06 IM14144
I ARMSDIR="" G SELECT ;ACR*2.1*13.06 IM14144
;S AFSLCMD="find "_AFSLIDIR_" -name "_%FN_" -print > /usr/spool/afsdata/tmpfl" D HOSTCMD^AFSLCKZC ;ACR*2.1*13.06 IM14144
S AFSLCMD="find "_AFSLIDIR_" -name "_%FN_" -print > "_ARMSDIR_"tmpfl" D HOSTCMD^AFSLCKZC ;ACR*2.1*13.06 IM14144
;
RDFLE ; RDFLE REWRITTEN ;ACR*2.1*13.02 IM13574 and ACR*2.1*13.06 IM14144
;S AFSERMSG=""
;S %FN="/usr/spool/afsdata/tmpfl",%IN=1 D OPENHFS^AFSLCK1 S IO=%DEV
;I AFSERMSG="M10" W !!?25,*7,"NO FILES FOUND" D VKILL Q
;F AFSLI=1:1 U IO R X:60 Q:X="" D ^AFSLCKZC Q:AFSLNZC=-1 S AFSLXFND(AFSLI)=X
;D ^%ZISC
;F I=1:1 Q:'$D(AFSLXFND(I)) I AFSLXFND(I)["reports/pccspc" S AFSLFFND=I Q
;I AFSLFFND'=0 S DY=21,DX=23 X XY W @AFSLRVON,"FOUND:",@AFSLRVOF," ",AFSLXFND(AFSLFFND) S AFSLOK="Y"
;I AFSLFFND=0 S DY=20,DX=62 F I=1:1:3 X XY W *7,@AFSLRVON,"NOT FOUND",@AFSLRVOF H 1 X XY W "NOT FOUND" H 1
;I AFSLFFND=0 S DY=22,DX=11 X XY W @AFSLRVON,"THE CONCATENATED DOWNLOADFILE MUST HAVE PATHNAME: "_AFSLIDIR_"/pccspc.nnn",@AFSLRVOF S AFSLOK="N"
;
; RDFLE REWRITTEN ;ACR*2.1*13.02 IM13574 and ACR*2.1*13.06 IM14144
S AFSERMSG=""
S %FN=ARMSDIR_"tmpfl" ;ACR*2.1*13.06 IM14144
S %IN=1 D OPENHFS^AFSLCK1 ;ACR*2.1*13.06 IM14144
I AFSERMSG="M10" W !!?25,*7,"NO FILES FOUND" H 3 D VKILL Q
F AFSLI=1:1 U IO R X:60 Q:X="" D ^AFSLCKZC Q:AFSLNZC=-1 S AFSLXFND(AFSLI)=X
D CLOSE^%ZISH("") ;ACR*2.1*13.02 IM13574
F I=1:1 Q:'$D(AFSLXFND(I)) I AFSLXFND(I)["pccspc" S AFSLFFND=I Q ;ACR*2.1*13.06 IM14144
I AFSLFFND'=0 S DY=21,DX=23 X XY W @AFSLRVON,"FOUND:",@AFSLRVOF," ",AFSLXFND(AFSLFFND) S AFSLOK="Y"
I AFSLFFND=0 S DY=20,DX=62 F I=1:1:3 X XY W *7,@AFSLRVON,"NOT FOUND",@AFSLRVOF H 1 X XY W "NOT FOUND" H 1
I AFSLFFND=0 S DY=22,DX=11 X XY W @AFSLRVON," DOWNLOAD FILE MUST HAVE PATHNAME: "_AFSLIDIR_"pccspc.nnn",@AFSLRVOF S AFSLOK="N"
;
CONT ;
;S DY=23,DX=18 X XY R "CONTINUE (Y/N) N//",AFSLCONT:300 ;ACR*2.1*13.02 IM13574
;I (AFSLCONT["Y"!(AFSLCONT["y"))&(AFSLOK="N") W " ",@AFSLRVON,"CANNOT IMPORT FILE AT THIS TIME",@AFSLRVOF H 3 G VKILL ;ACR*2.1*13.02 IM13574
;I (AFSLCONT["Y"!(AFSLCONT["y"))&(AFSLOK="Y") S DY=24 X XY W @AFSLRVON,"ARE YOU SURE? (Y/N) N//" R AFSLCONT:300 W @AFSLRVOF ;ACR*2.1*13.02 IM13574
;W !,"AFSLCONT=",AFSLCONT ;ACR*2.1*13.02 IM13574
;I AFSLCONT="Y"!(AFSLCONT="y") S AFSEXFN=AFSLXFND(AFSLFFND) D ^%ZISC D ^AFSLLDO2,LOGIT G VKILL ;ACR*2.1*13.02 IM13574
I AFSLOK="N" D G VKILL ;ACR*2.1*13.02 IM13574
.W @AFSLRVON," CANNOT IMPORT FILE AT THIS TIME",@AFSLRVOF H 3
D PAUSE^ACRFWARN ;ACR*2.1*13.02 IM13574
S AFSLCONT=$S(ACRY=1:"Y",1:"N") ;ACR*2.1*13.02 IM13574
I AFSLCONT="N" G VKILL ;ACR*2.1*13.02 IM13574
I AFSLOK="Y" D ;ACR*2.1*13.02 IM13574
.S DY=24 X XY W @AFSLRVON
.S DIR(0)="Y"
.S DIR("A")="ARE YOU SURE? (Y/N)",DIR("B")="N"
.D DIR^ACRFDIC
.S AFSLCONT=$S(ACRY=1:"Y",1:"N")
.W @AFSLRVOF
I AFSLCONT="N" G VKILL ;ACR*2.1*13.02 IM13574
I AFSLCONT="Y" D G VKILL ;ACR*2.1*13.02 IM13574
.S AFSEXFN=AFSLXFND(AFSLFFND)
.D CLOSE^%ZISH("") ;ACR*2.1*13.02 IM13574
.D ^AFSLLDO2,LOGIT
LOGIT ;
I '$D(AFSLLOGX) L -AFSLXLOC Q
S X=$P(^AFSLHASL(0),U,4)+1,$P(^AFSLHASL(0),U,3)=X,$P(^AFSLHASL(0),U,4)=X,^AFSLHASL(X,0)=AFSLLOGX S DIK="^AFSLHASL(" D IXALL^DIK
K X
L -AFSLXLOC
Q
VKILL ;
K %DEV,%FN,%FO,%IN,%ZA,AFSLFOK,AFSLSAD,AFSLXAST,AFSLXLOC,AFSLAPIN,AFSLCMD,AFSLCONT,AFSLDT,AFSLE,AFSLFFND,AFSLI,AFSLOK,AFSLXFND,AFSLXZ3,AFSLRVON,AFSLRVOF,DIC,DX,DY,I,X
K AFSLACRL,AFSLAPN,AFSLCRDT,AFSLCOMP,AFSLDSBT,AFSLDVC,AFSLFNM,AFSLIMN,AFSLINC,AFSLLADT,AFSLNZA,AFSLNZC,AFSLOBDT,AFSLOFLN,AFSLRED,AFSLTBL,AFSLTLFG,AFSLTLNM,AFSLX,K,XY,ZX,ZY
Q
SETTBL ;EP
S AFSLTBL(0)="+^0"
S AFSLTBL("A")="+^1",AFSLTBL("B")="+^2",AFSLTBL("C")="+^3",AFSLTBL("D")="+^4",AFSLTBL("E")="+^5",AFSLTBL("F")="+^6",AFSLTBL("G")="+^7",AFSLTBL("H")="+^8",AFSLTBL("I")="+^9"
S AFSLTBL("J")="-^1",AFSLTBL("K")="-^2",AFSLTBL("L")="-^3",AFSLTBL("M")="-^4",AFSLTBL("N")="-^5",AFSLTBL("O")="-^6",AFSLTBL("P")="-^7",AFSLTBL("Q")="-^8",AFSLTBL("R")="-^9"
Q
AFSLLDO1 ;IHS/OIRM/DSD/JDM - LOAD ODF FROM DOWNLOAD FILE; [ 10/27/2004 4:21 PM ]
+1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
+2 ;;ACR*2.1*9 MODIFIED FOR CACHE' COMPLIANCE
+3 ;Module to display message, find the file and continue
INFO DO ^XBCLS
DO CRTSETUP^AFSLCRTS
SET AFSLFFND=0
DO NOW^%DTC
SET AFSLDT=$PIECE(%,".",1)
KILL %,%H,%I,X
+1 DO SETTBL
+2 SET DY=2
SET DX=20
XECUTE XY
WRITE @AFSLRVON,"IHS 1166 APPROVALS FOR PAYMENT SYSTEM",@AFSLRVOF
+3 SET DY=3
SET DX=19
XECUTE XY
WRITE @AFSLRVON,"IMPORT H.A.S. OBLIGATIONS DOWNLOAD FILE",@AFSLRVOF
+4 SET DY=4
SET DX=2
XECUTE XY
WRITE @AFSLRVON," ",@AFSLRVOF
+5 SET DX=12
+6 SET DY=6
XECUTE XY
WRITE "This import process will completely replace all data"
+7 SET DY=7
XECUTE XY
WRITE "currently stored in your local obligations document"
+8 SET DY=8
XECUTE XY
WRITE "file with the current obligations data on file in the"
+9 SET DY=9
XECUTE XY
WRITE "Health Accounting System at Parklawn Computer Center."
+10 SET DY=11
XECUTE XY
WRITE "There should have been NO payment data entered into"
+11 SET DY=12
XECUTE XY
WRITE "the IHS 1166 APPROVALS FOR PAYMENT system since the"
+12 SET DY=13
XECUTE XY
WRITE "last DHR Data Entry splitout & transmission to PCC."
+13 SET DY=14
XECUTE XY
WRITE "Otherwise, that data must be re-entered after this"
+14 SET DY=15
XECUTE XY
WRITE "import process is completed. IT IS RECOMMENDED THAT"
+15 SET DY=16
XECUTE XY
WRITE "YOU REQUEST YOUR ADP SITE MANAGER SAVE THE GLOBAL"
+16 SET DY=17
XECUTE XY
WRITE "^AFSLODOC BEFORE YOU CONTINUE WITH THIS PROCESS."
+17 SET DY=18
SET DX=2
XECUTE XY
WRITE @AFSLRVON," ",@AFSLRVOF
+18 ;S DY=23,DX=18 X XY R "CONTINUE (Y/N) N//",AFSLCONT:300 ;ACR*2.1*13.02 IM13574
+19 ;I AFSLCONT'="Y"&(AFSLCONT'="y") D VKILL Q ; ACR*2.1*13.02 IM13574
+20 ;ACR*2.1*13.02 IM13574
DO PAUSE^ACRFWARN
+21 ;ACR*2.1*13.02 IM13574
IF ($GET(ACRY)=0)!($DATA(ACRQUIT))!($DATA(ACROUT))
DO VKILL
QUIT
+22 ;ACR*2.1*13.02 IM13574
SET AFSLCONT=$SELECT(ACRY=1:"Y",1:"N")
SELECT ;
+1 DO ^AFSLHASL
+2 IF AFSLCONT'="Y"&(AFSLCONT'="y")
DO VKILL
QUIT
+3 FOR I=19:1:23
SET DY=I
SET DX=1
USE IO(0)
XECUTE XY
WRITE $JUSTIFY("",80)
+4 ;S DY=20,DX=12 X XY W @AFSLRVON,"LOOKING FOR FILE:",@AFSLRVOF," "_AFSLIDIR_"/",%FN ;ACR*2.1*13.06 IM14144
+5 ;ACR*2.1*13.06 IM14144
SET DY=20
SET DX=12
XECUTE XY
WRITE @AFSLRVON,"LOOKING FOR FILE:",@AFSLRVOF," "_AFSLIDIR,%FN
+6 ;
+7 ;ACR*2.1*13.06 IM14144
NEW ARMSDIR
+8 ;ACR*2.1*13.06 IM14144
SET ARMSDIR=$$ARMSDIR^ACRFSYS(1)
+9 ;ACR*2.1*13.06 IM14144
IF ARMSDIR=""
GOTO SELECT
+10 ;S AFSLCMD="find "_AFSLIDIR_" -name "_%FN_" -print > /usr/spool/afsdata/tmpfl" D HOSTCMD^AFSLCKZC ;ACR*2.1*13.06 IM14144
+11 ;ACR*2.1*13.06 IM14144
SET AFSLCMD="find "_AFSLIDIR_" -name "_%FN_" -print > "_ARMSDIR_"tmpfl"
DO HOSTCMD^AFSLCKZC
+12 ;
RDFLE ; RDFLE REWRITTEN ;ACR*2.1*13.02 IM13574 and ACR*2.1*13.06 IM14144
+1 ;S AFSERMSG=""
+2 ;S %FN="/usr/spool/afsdata/tmpfl",%IN=1 D OPENHFS^AFSLCK1 S IO=%DEV
+3 ;I AFSERMSG="M10" W !!?25,*7,"NO FILES FOUND" D VKILL Q
+4 ;F AFSLI=1:1 U IO R X:60 Q:X="" D ^AFSLCKZC Q:AFSLNZC=-1 S AFSLXFND(AFSLI)=X
+5 ;D ^%ZISC
+6 ;F I=1:1 Q:'$D(AFSLXFND(I)) I AFSLXFND(I)["reports/pccspc" S AFSLFFND=I Q
+7 ;I AFSLFFND'=0 S DY=21,DX=23 X XY W @AFSLRVON,"FOUND:",@AFSLRVOF," ",AFSLXFND(AFSLFFND) S AFSLOK="Y"
+8 ;I AFSLFFND=0 S DY=20,DX=62 F I=1:1:3 X XY W *7,@AFSLRVON,"NOT FOUND",@AFSLRVOF H 1 X XY W "NOT FOUND" H 1
+9 ;I AFSLFFND=0 S DY=22,DX=11 X XY W @AFSLRVON,"THE CONCATENATED DOWNLOADFILE MUST HAVE PATHNAME: "_AFSLIDIR_"/pccspc.nnn",@AFSLRVOF S AFSLOK="N"
+10 ;
+11 ; RDFLE REWRITTEN ;ACR*2.1*13.02 IM13574 and ACR*2.1*13.06 IM14144
+12 SET AFSERMSG=""
+13 ;ACR*2.1*13.06 IM14144
SET %FN=ARMSDIR_"tmpfl"
+14 ;ACR*2.1*13.06 IM14144
SET %IN=1
DO OPENHFS^AFSLCK1
+15 IF AFSERMSG="M10"
WRITE !!?25,*7,"NO FILES FOUND"
HANG 3
DO VKILL
QUIT
+16 FOR AFSLI=1:1
USE IO
READ X:60
IF X=""
QUIT
DO ^AFSLCKZC
IF AFSLNZC=-1
QUIT
SET AFSLXFND(AFSLI)=X
+17 ;ACR*2.1*13.02 IM13574
DO CLOSE^%ZISH("")
+18 ;ACR*2.1*13.06 IM14144
FOR I=1:1
IF '$DATA(AFSLXFND(I))
QUIT
IF AFSLXFND(I)["pccspc"
SET AFSLFFND=I
QUIT
+19 IF AFSLFFND'=0
SET DY=21
SET DX=23
XECUTE XY
WRITE @AFSLRVON,"FOUND:",@AFSLRVOF," ",AFSLXFND(AFSLFFND)
SET AFSLOK="Y"
+20 IF AFSLFFND=0
SET DY=20
SET DX=62
FOR I=1:1:3
XECUTE XY
WRITE *7,@AFSLRVON,"NOT FOUND",@AFSLRVOF
HANG 1
XECUTE XY
WRITE "NOT FOUND"
HANG 1
+21 IF AFSLFFND=0
SET DY=22
SET DX=11
XECUTE XY
WRITE @AFSLRVON," DOWNLOAD FILE MUST HAVE PATHNAME: "_AFSLIDIR_"pccspc.nnn",@AFSLRVOF
SET AFSLOK="N"
+22 ;
CONT ;
+1 ;S DY=23,DX=18 X XY R "CONTINUE (Y/N) N//",AFSLCONT:300 ;ACR*2.1*13.02 IM13574
+2 ;I (AFSLCONT["Y"!(AFSLCONT["y"))&(AFSLOK="N") W " ",@AFSLRVON,"CANNOT IMPORT FILE AT THIS TIME",@AFSLRVOF H 3 G VKILL ;ACR*2.1*13.02 IM13574
+3 ;I (AFSLCONT["Y"!(AFSLCONT["y"))&(AFSLOK="Y") S DY=24 X XY W @AFSLRVON,"ARE YOU SURE? (Y/N) N//" R AFSLCONT:300 W @AFSLRVOF ;ACR*2.1*13.02 IM13574
+4 ;W !,"AFSLCONT=",AFSLCONT ;ACR*2.1*13.02 IM13574
+5 ;I AFSLCONT="Y"!(AFSLCONT="y") S AFSEXFN=AFSLXFND(AFSLFFND) D ^%ZISC D ^AFSLLDO2,LOGIT G VKILL ;ACR*2.1*13.02 IM13574
+6 ;ACR*2.1*13.02 IM13574
IF AFSLOK="N"
Begin DoDot:1
+7 WRITE @AFSLRVON," CANNOT IMPORT FILE AT THIS TIME",@AFSLRVOF
HANG 3
End DoDot:1
GOTO VKILL
+8 ;ACR*2.1*13.02 IM13574
DO PAUSE^ACRFWARN
+9 ;ACR*2.1*13.02 IM13574
SET AFSLCONT=$SELECT(ACRY=1:"Y",1:"N")
+10 ;ACR*2.1*13.02 IM13574
IF AFSLCONT="N"
GOTO VKILL
+11 ;ACR*2.1*13.02 IM13574
IF AFSLOK="Y"
Begin DoDot:1
+12 SET DY=24
XECUTE XY
WRITE @AFSLRVON
+13 SET DIR(0)="Y"
+14 SET DIR("A")="ARE YOU SURE? (Y/N)"
SET DIR("B")="N"
+15 DO DIR^ACRFDIC
+16 SET AFSLCONT=$SELECT(ACRY=1:"Y",1:"N")
+17 WRITE @AFSLRVOF
End DoDot:1
+18 ;ACR*2.1*13.02 IM13574
IF AFSLCONT="N"
GOTO VKILL
+19 ;ACR*2.1*13.02 IM13574
IF AFSLCONT="Y"
Begin DoDot:1
+20 SET AFSEXFN=AFSLXFND(AFSLFFND)
+21 ;ACR*2.1*13.02 IM13574
DO CLOSE^%ZISH("")
+22 DO ^AFSLLDO2
DO LOGIT
End DoDot:1
GOTO VKILL
LOGIT ;
+1 IF '$DATA(AFSLLOGX)
LOCK -AFSLXLOC
QUIT
+2 SET X=$PIECE(^AFSLHASL(0),U,4)+1
SET $PIECE(^AFSLHASL(0),U,3)=X
SET $PIECE(^AFSLHASL(0),U,4)=X
SET ^AFSLHASL(X,0)=AFSLLOGX
SET DIK="^AFSLHASL("
DO IXALL^DIK
+3 KILL X
+4 LOCK -AFSLXLOC
+5 QUIT
VKILL ;
+1 KILL %DEV,%FN,%FO,%IN,%ZA,AFSLFOK,AFSLSAD,AFSLXAST,AFSLXLOC,AFSLAPIN,AFSLCMD,AFSLCONT,AFSLDT,AFSLE,AFSLFFND,AFSLI,AFSLOK,AFSLXFND,AFSLXZ3,AFSLRVON,AFSLRVOF,DIC,DX,DY,I,X
+2 KILL AFSLACRL,AFSLAPN,AFSLCRDT,AFSLCOMP,AFSLDSBT,AFSLDVC,AFSLFNM,AFSLIMN,AFSLINC,AFSLLADT,AFSLNZA,AFSLNZC,AFSLOBDT,AFSLOFLN,AFSLRED,AFSLTBL,AFSLTLFG,AFSLTLNM,AFSLX,K,XY,ZX,ZY
+3 QUIT
SETTBL ;EP
+1 SET AFSLTBL(0)="+^0"
+2 SET AFSLTBL("A")="+^1"
SET AFSLTBL("B")="+^2"
SET AFSLTBL("C")="+^3"
SET AFSLTBL("D")="+^4"
SET AFSLTBL("E")="+^5"
SET AFSLTBL("F")="+^6"
SET AFSLTBL("G")="+^7"
SET AFSLTBL("H")="+^8"
SET AFSLTBL("I")="+^9"
+3 SET AFSLTBL("J")="-^1"
SET AFSLTBL("K")="-^2"
SET AFSLTBL("L")="-^3"
SET AFSLTBL("M")="-^4"
SET AFSLTBL("N")="-^5"
SET AFSLTBL("O")="-^6"
SET AFSLTBL("P")="-^7"
SET AFSLTBL("Q")="-^8"
SET AFSLTBL("R")="-^9"
+4 QUIT
