source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRSP1.m

RMPRSP1 ;PHX/RFM/HPL/HNC-PRINT 5 DAY OLD SUSPENSE RECORDS ;8/29/1994
 ;;3.0;PROSTHETICS;**45,52,77**;Feb 09, 1996
 ;
 ; ODJ - patch 52 - 10/18/00 - fix undefined text line at EXT
 ;RVD patch #77 - change IO to ION
 ;
 D DIV4^RMPRSIT G:$D(X) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1
 I '$D(IO("Q")) U IO G PRINT
 K IO("Q") S ZTDESC="PRINT 5 DAY OLD SUSPENSE RECORDS",ZTRTN="PRINT^RMPRSP1",ZTIO=ION,ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMPRSITE")=""
 D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1
PRINT W:$E(IOST)["C-" @IOF S RMPRPAGE=1 F I=1:1:11 S FOT(I)=0,TOT=0
C S RMPREDT=$$FMADD^XLFDT(DT,-7),RO=0,RB=$$FMADD^XLFDT(DT,-90) F  S RB=$O(^RMPR(668,"B",RB)) Q:RB>RMPREDT!(RB'>0)  F  S RO=$O(^RMPR(668,"B",RB,RO)) Q:RO=""  D CK
 G WRI
CK Q:'$D(^RMPR(668,RO,0))
 Q:$P(^RMPR(668,RO,0),U,10)'="O"
 Q:$P(^RMPR(668,RO,0),U,9)>0!($P(^(0),U)'>0)!($P(^(0),U,3)'>0)!('+$P(^(0),U,2))
 Q:$P(^RMPR(668,RO,0),U,7)'=RMPR("STA")
 S ^TMP($J,$P(^RMPR(668,RO,0),U),$P(^DPT($P(^RMPR(668,RO,0),U,2),0),U),$S($P(^(0),U,4)>0:$P(^(0),U,4),1:1),RO)=""
 Q
WRI ;
 N RP,RQ,RZ,RS
 S RP=0,RQ=0,RZ=0,RS=0
 F  S RP=$O(^TMP($J,RP)) Q:RP=""  F  S RQ=$O(^TMP($J,RP,RQ)) Q:RQ=""  F  S RS=$O(^TMP($J,RP,RQ,RS)) Q:RS=""  F  S RZ=$O(^TMP($J,RP,RQ,RS,RZ)) Q:RZ=""!($D(RMPREND))  D WRI2
 I $D(RMPREND) G EXIT1
 ;
 ;
 I '$D(^TMP($J)) D
 .  S Y=DT D DD^%DT W !,Y,?25,"OVER 5 DAY OLD SUSPENSE REPORT"
 .  W !!,"No open suspense records over 5 days!" S RMPREX=1
 I $D(RMPREX) K RMPREX G EXIT1
 ;
 W ! F I=1:1:79 W "-"
 W !,"PSC",?5,"2421",?11,"2237",?17,"2529-3",?25,"2529-7",?33,"2474",?39,"2431",?45,"2914",?51,"OTHER",?58,"2520",?64,"STK ISU",?74,"TOTAL"
 W !,$J(FOT(1),3),?5,$J(FOT(2),4),?11,$J(FOT(3),4),?17,$J(FOT(4),6),?25,$J(FOT(5),6),?33,$J(FOT(6),4),?39,$J(FOT(7),4),?45,$J(FOT(8),4),?51,$J(FOT(9),5),?58,$J(FOT(10),4),?64,$J(FOT(11),7)
 S RO=0
 F  S RO=$O(FOT(RO)) Q:RO=""  S TOT=TOT+FOT(RO)
 W ?74,$J(TOT,5)
 I $E(IOST)["C-" W ! K DIR S DIR(0)="E" D ^DIR
 ;
EXIT1 ;common exit
 K FO,I,TOT,FOT,RMPREDT,RMPRFLG,RMPRFL,RMPREND,RMPRPAGE,RMPRG,X,Y
 K RMPRFORM,DIR,RP,RS,RQ,RO,RB,RZ,RMPRFOR1,^TMP($J),RP,RR,RMPRFOR2
 D ^%ZISC
 Q
 ;
WRI2 I RMPRPAGE=1,'$D(RMPRFL) W:$Y>1 @IOF D HEADER1 Q:$D(RMPREND)
 I $Y>(IOSL-6),$E(IOST)["C-",$D(RMPRFL) D HEADER Q:$D(RMPREND)
 I $Y>(IOSL-6),$D(RMPRFL) W @IOF D HEADER1
WRI3 ;
 N DAT1
 S DAT1=$$DAT1^RMPRUTL1(RP)
 W !,DAT1,?13,$E($P(^DPT($P(^RMPR(668,RZ,0),U,2),0),U),1,20),?35,$E($P(^(0),U,9),6,9)
 D FORM
 W ?59,$S($D(^VA(200,+$P(^RMPR(668,RZ,0),U,4),0)):$E($P(^VA(200,$P(^RMPR(668,RZ,0),U,4),0),U),1,19),1:"NO NAME AVAILABLE")
 S RMPRFL=1
 Q:$D(RMPREND)
 D:$D(^RMPR(668,RZ,2,0)) EXT
 Q
HEADER ;
 W !
 S DIR(0)="E" D ^DIR K DIR
 I Y=""!(Y=0) S RMPREND=1 Q:Y=""!(Y=0)
 W @IOF
 ;
HEADER1 ;
 Q:$D(RMPREND)
 S RMPRFL=1
 W !,?23,"DELINQUENT OPEN SUSPENSE REPORT",?70,"STA ",$$STA^RMPRUTIL,!,?2,"DATE",?18,"PATIENT",?35,"SSN",?41,"FORM",?59,"SUSPENDED BY",?73,"PAGE ",RMPRPAGE,!
 S RMPRPAGE=RMPRPAGE+1
 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
 Q
 ;
EXT ;display only the first line of description
 ;modified in patch 52
 N RR
 S RR=$O(^RMPR(668,RZ,2,0))
 W:+RR !,$G(^RMPR(668,RZ,2,RR,0))
 ;display the entire description
 ;N RR
 ;S RR=0
 ;F  S RR=$O(^RMPR(668,RZ,2,RR)) W:RR="" ! Q:RR=""!($D(RMPREND))  D PEXT
 Q
 ;
PEXT ;
 ;I $Y>(IOSL-6),$E(IOST)["C",$D(RMPRFL) S RMPRFLG=1 D HEADER Q:$D(RMPREND)
 ;I $Y>(IOSL-6),$D(RMPRFL) W @IOF S RMPRFLG=1 D HEADER1
 ;W !,$P(^RMPR(668,RZ,2,RR,0),U)
 Q
 ;
FORM ;
 S FO=$P(^RMPR(668,RZ,0),U,3)
 W ?41,$S(FO=1:"PSC",FO=2:"2421",FO=3:"2237",FO=4:"2529-3",FO=5:"2529-7",FO=6:"2474",FO=7:"2431",FO=8:"2914",FO=9:"OTHER",FO=10:"2520",FO=11:"STOCK ISSUE",1:"UNK")
 S $P(FOT(FO),U)=$P(FOT(FO),U)+1
 Q