AFSLDIQ2 ;IHS/OIRM/DSD/JDM - DOC# INQUIRY LOOKUP; [ 10/27/2004 4:21 PM ]
;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
;;MODIFIED FOR CACHE' COMPLIANCE ACR*2.1*9
;Allows viewing of document and payment history - part 2
;ACR*2.1*13.02 IM13574 ;REMOVED DUPLICATE SUBROUTINES
K AFSLDFND,AFSLDNOD,AFSLDZRO,AFSLTDOC
K ^TMP("AFSLOTMP",$J)
S AFSLDNOD=99999
S AFSLTDCT=1
S (AFSLDNX,AFSLSTRT,AFSLDNXS)=0
S AFSLDNX=AFSLDOC-1
DOIT ;
I '$D(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC)) S Y=-1 G FINI
S AFSLDNXS=$O(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,0))
S AFSLDNOD=AFSLDNXS
K AFSLX
S $P(AFSLX,U,1)=AFSLTDCT
S $P(AFSLX,U,2)=$P($G(^AFSLODOC(AFSLYNOD,1,AFSLDNOD,2)),U,1)
S $P(AFSLX,U,3)=AFSLDNOD
S $P(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNOD,0)
S ^TMP("AFSLOTMP",$J,AFSLTDCT)=AFSLX
DOITLP2 ;
I '$O(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS)) G CHKDOC
S AFSLDNDN=$O(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS))
S AFSLTDCT=AFSLTDCT+1
K AFSLX
S $P(AFSLX,U,1)=AFSLTDCT
S $P(AFSLX,U,2)=$P($G(^AFSLODOC(AFSLYNOD,1,AFSLDNDN,2)),U,1)
S $P(AFSLX,U,3)=AFSLDNDN
S $P(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNDN,0)
S ^TMP("AFSLOTMP",$J,AFSLTDCT)=AFSLX
S AFSLDNXS=AFSLDNDN
G DOITLP2
CHKDOC ;
I '$D(^TMP("AFSLOTMP",$J,1)) S Y=-1 G FINI
DSPHDR ;
D ^XBCLS
S DY=2,DX=18
X XY
W @AFSLRVON,"VERIFY DOCUMENT SELECTION FOR 1166 PAYMENT",@AFSLRVOF
S DY=5
S DX=2
X XY
W @AFSLRVON,"SEQ#",@AFSLRVOF," "
W @AFSLRVON,"REF.",@AFSLRVOF," "
W @AFSLRVON,"DOCUMENT #",@AFSLRVOF," "
W @AFSLRVON,"EFF.DATE",@AFSLRVOF
W " "
W @AFSLRVON,"CAN NO.",@AFSLRVOF," "
W @AFSLRVON,"CLASS",@AFSLRVOF," "
W @AFSLRVON,"TYPE",@AFSLRVOF," "
W @AFSLRVON,"FED",@AFSLRVOF," "
W @AFSLRVON,"OBLIGATION $$",@AFSLRVOF
S DY=6
F I=1:1:999 Q:AFSLENUF["^" I $D(^TMP("AFSLOTMP",$J,I)) D DSPDOCS
SELDOC ;
S AFSLLTH=$L(AFSLTDCT)
S AFSLDOCC="^"
S DY=22
S DX=23
X XY
S DX=53 ; ACR*2.1*13.02 IM13574
X XY ; ACR*2.1*13.02 IM13574
W *7,@AFSLRVON ; ACR*2.1*13.02 IM13574
S DIR(0)="L^1:"_AFSLTDCT ; ACR*2.1*13.02 IM13574
S DIR("A")="ENTER SEQ# OR ""^"" TO ABORT ^//" ; ACR*2.1*13.02 IM13574
D DIR^ACRFDIC ; ACR*2.1*13.02 IM13574
W @AFSLRVOF ; ACR*2.1*13.02 IM13574
I $D(ACRQUIT)!($D(ACROUT)) D G FINI ; ACR*2.1*13.02 IM13574
.S AFSLCONT=U ; ACR*2.1*13.02 IM13574
S AFSLDOCC=Y ; ACR*2.1*13.02 IM13574
I AFSLDOCC'?.N!(AFSLDOCC>AFSLTDCT)!(AFSLDOCC<1) D G SELDOC
.S DY=23
.S DX=7
.X XY
.W @AFSLRVON ; ACR*2.1*13.02 IM13574
.W *7,"**** MUST ENTER ONE OF THE SEQUENCE NUMBERS ABOVE OR ""^"" ****"
W @AFSLRVOF
S AFSLDOCC=$P(^TMP("AFSLOTMP",$J,+AFSLDOCC),U,3)
S Y=1
FINI ;
I '$D(Y) Q
I Y=-1 S AFSLDOCC=""
QUIT
DSPDOCS ;
S DY=DY+1
I DY=20 D
.W *7
.S DIR(0)="YO"
.S DIR("A",1)="ENTER '^' TO STOP VIEWING"
.S DIR("A")="PRESS RETURN FOR MORE"
.D ^DIR
.S AFSLENUF=X
.F L=7:1:21 D
..S DY=L
..S DX=2
..X XY
..W " "
I DY=21 S DY=7
S:$P(^TMP("AFSLOTMP",$J,I),U,13)="" $P(^TMP("AFSLOTMP",$J,I),U,13)="000000000000"
S AFSLTDOL=$P(^TMP("AFSLOTMP",$J,I),U,13)
S AFSLTDOL=$E(AFSLTDOL,2,11)_"."_$E(AFSLTDOL,12,13)
S $P(^TMP("AFSLOTMP",$J,I),U,13)=AFSLTDOL
K AFSLX
S AFSLX=^TMP("AFSLOTMP",$J,I)
S DX=2
X XY
W $P(AFSLX,U,1)
S DX=8
X XY
W $P(AFSLX,U,2)
S DX=14
X XY
W $P(AFSLX,U,4)
S DX=27
X XY
W $P(AFSLX,U,12)
S DX=36
X XY
W $P(AFSLX,U,6)
S DX=45
X XY
W $P(AFSLX,U,7)
S DX=53
X XY
W $P(AFSLX,U,9)
S DX=59
X XY
W $P(AFSLX,U,8)
S DX=63
X XY
W $P(AFSLX,U,13)
Q
XXX ;
;I '$D(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC)) S Y=-1 G FINI
F S AFSLDNXS=$O(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS)) Q:'AFSLDNXS D
.S AFSLDNOD=AFSLDNXS
.K AFSLX
.S $P(AFSLX,U,1)=AFSLTDCT
.S $P(AFSLX,U,2)=$P($G(^AFSLODOC(AFSLYNOD,1,AFSLDNOD,2)),U,1)
.S $P(AFSLX,U,3)=AFSLDNOD
.S $P(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNOD,0)
.S ^TMP("AFSLOTMP",$J,AFSLTDCT)=AFSLX
.S AFSLTDCT=AFSLTDCT+1
Q
AFSLDIQ2 ;IHS/OIRM/DSD/JDM - DOC# INQUIRY LOOKUP; [ 10/27/2004 4:21 PM ]
+1 ;;3.0t1;1166 APPROVALS FOR PAYMENT;**13**;
+2 ;;MODIFIED FOR CACHE' COMPLIANCE ACR*2.1*9
+3 ;Allows viewing of document and payment history - part 2
+4 ;ACR*2.1*13.02 IM13574 ;REMOVED DUPLICATE SUBROUTINES
+5 KILL AFSLDFND,AFSLDNOD,AFSLDZRO,AFSLTDOC
+6 KILL ^TMP("AFSLOTMP",$JOB)
+7 SET AFSLDNOD=99999
+8 SET AFSLTDCT=1
+9 SET (AFSLDNX,AFSLSTRT,AFSLDNXS)=0
+10 SET AFSLDNX=AFSLDOC-1
DOIT ;
+1 IF '$DATA(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC))
SET Y=-1
GOTO FINI
+2 SET AFSLDNXS=$ORDER(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,0))
+3 SET AFSLDNOD=AFSLDNXS
+4 KILL AFSLX
+5 SET $PIECE(AFSLX,U,1)=AFSLTDCT
+6 SET $PIECE(AFSLX,U,2)=$PIECE($GET(^AFSLODOC(AFSLYNOD,1,AFSLDNOD,2)),U,1)
+7 SET $PIECE(AFSLX,U,3)=AFSLDNOD
+8 SET $PIECE(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNOD,0)
+9 SET ^TMP("AFSLOTMP",$JOB,AFSLTDCT)=AFSLX
DOITLP2 ;
+1 IF '$ORDER(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS))
GOTO CHKDOC
+2 SET AFSLDNDN=$ORDER(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS))
+3 SET AFSLTDCT=AFSLTDCT+1
+4 KILL AFSLX
+5 SET $PIECE(AFSLX,U,1)=AFSLTDCT
+6 SET $PIECE(AFSLX,U,2)=$PIECE($GET(^AFSLODOC(AFSLYNOD,1,AFSLDNDN,2)),U,1)
+7 SET $PIECE(AFSLX,U,3)=AFSLDNDN
+8 SET $PIECE(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNDN,0)
+9 SET ^TMP("AFSLOTMP",$JOB,AFSLTDCT)=AFSLX
+10 SET AFSLDNXS=AFSLDNDN
+11 GOTO DOITLP2
CHKDOC ;
+1 IF '$DATA(^TMP("AFSLOTMP",$JOB,1))
SET Y=-1
GOTO FINI
DSPHDR ;
+1 DO ^XBCLS
+2 SET DY=2
SET DX=18
+3 XECUTE XY
+4 WRITE @AFSLRVON,"VERIFY DOCUMENT SELECTION FOR 1166 PAYMENT",@AFSLRVOF
+5 SET DY=5
+6 SET DX=2
+7 XECUTE XY
+8 WRITE @AFSLRVON,"SEQ#",@AFSLRVOF," "
+9 WRITE @AFSLRVON,"REF.",@AFSLRVOF," "
+10 WRITE @AFSLRVON,"DOCUMENT #",@AFSLRVOF," "
+11 WRITE @AFSLRVON,"EFF.DATE",@AFSLRVOF
+12 WRITE " "
+13 WRITE @AFSLRVON,"CAN NO.",@AFSLRVOF," "
+14 WRITE @AFSLRVON,"CLASS",@AFSLRVOF," "
+15 WRITE @AFSLRVON,"TYPE",@AFSLRVOF," "
+16 WRITE @AFSLRVON,"FED",@AFSLRVOF," "
+17 WRITE @AFSLRVON,"OBLIGATION $$",@AFSLRVOF
+18 SET DY=6
+19 FOR I=1:1:999
IF AFSLENUF["^"
QUIT
IF $DATA(^TMP("AFSLOTMP",$JOB,I))
DO DSPDOCS
SELDOC ;
+1 SET AFSLLTH=$LENGTH(AFSLTDCT)
+2 SET AFSLDOCC="^"
+3 SET DY=22
+4 SET DX=23
+5 XECUTE XY
+6 ; ACR*2.1*13.02 IM13574
SET DX=53
+7 ; ACR*2.1*13.02 IM13574
XECUTE XY
+8 ; ACR*2.1*13.02 IM13574
WRITE *7,@AFSLRVON
+9 ; ACR*2.1*13.02 IM13574
SET DIR(0)="L^1:"_AFSLTDCT
+10 ; ACR*2.1*13.02 IM13574
SET DIR("A")="ENTER SEQ# OR ""^"" TO ABORT ^//"
+11 ; ACR*2.1*13.02 IM13574
DO DIR^ACRFDIC
+12 ; ACR*2.1*13.02 IM13574
WRITE @AFSLRVOF
+13 ; ACR*2.1*13.02 IM13574
IF $DATA(ACRQUIT)!($DATA(ACROUT))
Begin DoDot:1
+14 ; ACR*2.1*13.02 IM13574
SET AFSLCONT=U
End DoDot:1
GOTO FINI
+15 ; ACR*2.1*13.02 IM13574
SET AFSLDOCC=Y
+16 IF AFSLDOCC'?.N!(AFSLDOCC>AFSLTDCT)!(AFSLDOCC<1)
Begin DoDot:1
+17 SET DY=23
+18 SET DX=7
+19 XECUTE XY
+20 ; ACR*2.1*13.02 IM13574
WRITE @AFSLRVON
+21 WRITE *7,"**** MUST ENTER ONE OF THE SEQUENCE NUMBERS ABOVE OR ""^"" ****"
End DoDot:1
GOTO SELDOC
+22 WRITE @AFSLRVOF
+23 SET AFSLDOCC=$PIECE(^TMP("AFSLOTMP",$JOB,+AFSLDOCC),U,3)
+24 SET Y=1
FINI ;
+1 IF '$DATA(Y)
QUIT
+2 IF Y=-1
SET AFSLDOCC=""
+3 QUIT
DSPDOCS ;
+1 SET DY=DY+1
+2 IF DY=20
Begin DoDot:1
+3 WRITE *7
+4 SET DIR(0)="YO"
+5 SET DIR("A",1)="ENTER '^' TO STOP VIEWING"
+6 SET DIR("A")="PRESS RETURN FOR MORE"
+7 DO ^DIR
+8 SET AFSLENUF=X
+9 FOR L=7:1:21
Begin DoDot:2
+10 SET DY=L
+11 SET DX=2
+12 XECUTE XY
+13 WRITE " "
End DoDot:2
End DoDot:1
+14 IF DY=21
SET DY=7
+15 IF $PIECE(^TMP("AFSLOTMP",$JOB,I),U,13)=""
SET $PIECE(^TMP("AFSLOTMP",$JOB,I),U,13)="000000000000"
+16 SET AFSLTDOL=$PIECE(^TMP("AFSLOTMP",$JOB,I),U,13)
+17 SET AFSLTDOL=$EXTRACT(AFSLTDOL,2,11)_"."_$EXTRACT(AFSLTDOL,12,13)
+18 SET $PIECE(^TMP("AFSLOTMP",$JOB,I),U,13)=AFSLTDOL
+19 KILL AFSLX
+20 SET AFSLX=^TMP("AFSLOTMP",$JOB,I)
+21 SET DX=2
+22 XECUTE XY
+23 WRITE $PIECE(AFSLX,U,1)
+24 SET DX=8
+25 XECUTE XY
+26 WRITE $PIECE(AFSLX,U,2)
+27 SET DX=14
+28 XECUTE XY
+29 WRITE $PIECE(AFSLX,U,4)
+30 SET DX=27
+31 XECUTE XY
+32 WRITE $PIECE(AFSLX,U,12)
+33 SET DX=36
+34 XECUTE XY
+35 WRITE $PIECE(AFSLX,U,6)
+36 SET DX=45
+37 XECUTE XY
+38 WRITE $PIECE(AFSLX,U,7)
+39 SET DX=53
+40 XECUTE XY
+41 WRITE $PIECE(AFSLX,U,9)
+42 SET DX=59
+43 XECUTE XY
+44 WRITE $PIECE(AFSLX,U,8)
+45 SET DX=63
+46 XECUTE XY
+47 WRITE $PIECE(AFSLX,U,13)
+48 QUIT
XXX ;
+1 ;I '$D(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC)) S Y=-1 G FINI
+2 FOR
SET AFSLDNXS=$ORDER(^AFSLODOC(AFSLYNOD,1,"B",AFSLDOC,AFSLDNXS))
IF 'AFSLDNXS
QUIT
Begin DoDot:1
+3 SET AFSLDNOD=AFSLDNXS
+4 KILL AFSLX
+5 SET $PIECE(AFSLX,U,1)=AFSLTDCT
+6 SET $PIECE(AFSLX,U,2)=$PIECE($GET(^AFSLODOC(AFSLYNOD,1,AFSLDNOD,2)),U,1)
+7 SET $PIECE(AFSLX,U,3)=AFSLDNOD
+8 SET $PIECE(AFSLX,U,4)=^AFSLODOC(AFSLYNOD,1,AFSLDNOD,0)
+9 SET ^TMP("AFSLOTMP",$JOB,AFSLTDCT)=AFSLX
+10 SET AFSLTDCT=AFSLTDCT+1
End DoDot:1
+11 QUIT
