| 1 | RMPRSP3 ;HINES/HNC; - Print Pending Suspense Records File 668 ;5-5-00
|
|---|
| 2 | ;;3.0;PROSTHETICS;**45,55,77**;Feb 09, 1996
|
|---|
| 3 | ; RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
|
|---|
| 4 | ;
|
|---|
| 5 | ;station from CPRS may not be the same as site params, can not filter
|
|---|
| 6 | ;station is from duz(2), the division in file 200, or
|
|---|
| 7 | ;default institution in kernel system parameters file 8989.3.
|
|---|
| 8 | ;
|
|---|
| 9 | EN ;PRINT PENDING SUSPENSE
|
|---|
| 10 | ;
|
|---|
| 11 | S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
|
|---|
| 12 | I '$D(IO("Q")) U IO G PRINT
|
|---|
| 13 | K IO("Q") S ZTDESC="PRINT OPEN/PENDING SUMMARY SUSPENSE",ZTRTN="PRINT^RMPRSP3",ZTIO=ION
|
|---|
| 14 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
|
|---|
| 15 | ;
|
|---|
| 16 | PRINT I '$D(IO("Q")) U IO
|
|---|
| 17 | W:$E(IOST)["C" @IOF
|
|---|
| 18 | S RMPRPAGE=1
|
|---|
| 19 | K ^TMP($J)
|
|---|
| 20 | ;
|
|---|
| 21 | ALL ;main sort logic
|
|---|
| 22 | ;REQUIRED VARIABLES: RMPRPAGE - PAGE NUMBER
|
|---|
| 23 | ;
|
|---|
| 24 | ;VARIABLES SET: RP - DATE OF SUPENSE RECORD
|
|---|
| 25 | ; RO - ENTRY NUMBER IN SUSPENSE
|
|---|
| 26 | S RP=0
|
|---|
| 27 | F S RP=$O(^RMPR(668,"B",RP)) Q:RP'>0 D
|
|---|
| 28 | .S RO=0
|
|---|
| 29 | .F S RO=$O(^RMPR(668,"B",RP,RO)) Q:RO'>0 D CK1
|
|---|
| 30 | G WRI
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | CK1 ;screen records
|
|---|
| 34 | Q:$P(^RMPR(668,RO,0),U,10)="X"
|
|---|
| 35 | Q:$P(^RMPR(668,RO,0),U,10)="C"
|
|---|
| 36 | ;
|
|---|
| 37 | S DFN=$P(^RMPR(668,RO,0),U,2) Q:DFN=""
|
|---|
| 38 | D DEM^VADPT
|
|---|
| 39 | S ^TMP($J,$P(^RMPR(668,RO,0),U,1),$P(VADM(1),U,1),RO)=""
|
|---|
| 40 | K VADM
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | WRI I '$D(^TMP($J)) W !,"No Open/Pending Suspense Records",! G EXIT
|
|---|
| 44 | ;date/time
|
|---|
| 45 | S RP=0
|
|---|
| 46 | F S RP=$O(^TMP($J,RP)) Q:RP="" D
|
|---|
| 47 | .;patient name
|
|---|
| 48 | .S RQ=""
|
|---|
| 49 | .F S RQ=$O(^TMP($J,RP,RQ)) Q:RQ="" D
|
|---|
| 50 | . .;record number
|
|---|
| 51 | . .S RZ=""
|
|---|
| 52 | . .F S RZ=$O(^TMP($J,RP,RQ,RZ)) Q:RZ=""!($D(RMPREND)) D WRI2
|
|---|
| 53 | ;
|
|---|
| 54 | EXIT K ^TMP($J) D ^%ZISC,KILL^XUSCLEAN Q
|
|---|
| 55 | ;
|
|---|
| 56 | WRI2 I RMPRPAGE=1,'$D(RMPRFL) W:$Y>1 @IOF D HEADER1 Q:$D(RMPREND)
|
|---|
| 57 | I $Y>(IOSL-6),$E(IOST)["C",$D(RMPRFL) D HEADER Q:$D(RMPREND)
|
|---|
| 58 | I $Y>(IOSL-6),$D(RMPRFL) W @IOF D HEADER1
|
|---|
| 59 | ;
|
|---|
| 60 | W !,$$DAT1^RMPRUTL1(RP)
|
|---|
| 61 | W ?10,$$STATUS^RMPREOU(RZ,4)
|
|---|
| 62 | S WRKDAY=$$CWRKDAY^RMPREOU(RZ) W " ",WRKDAY K WRKDAY
|
|---|
| 63 | W ?24,$E($P(^DPT($P(^RMPR(668,RZ,0),U,2),0),U),1,20),?42,$E($P(^(0),U,9),6,9)
|
|---|
| 64 | D TYPE
|
|---|
| 65 | W ?61,$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
|
|---|
| 66 | Q:$D(RMPREND)
|
|---|
| 67 | ;
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | HEADER W ! S DIR(0)="E" D ^DIR K DIR S:Y<1 RMPREND=1 Q:Y=""!(Y=0) W @IOF
|
|---|
| 71 | ;
|
|---|
| 72 | HEADER1 Q:$D(RMPREND) S RMPRFL=1
|
|---|
| 73 | W !,"Prosthetics Open/Pending Summary Suspense List "
|
|---|
| 74 | N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
|
|---|
| 75 | W ?70,"STA ",$$STA^RMPRUTIL,!,"DATE",?10,"STATUS",?24,"PATIENT"
|
|---|
| 76 | W ?42,"SSN",?48,"TYPE",?61,"SUSPENDED BY",?73,"PAGE ",RMPRPAGE
|
|---|
| 77 | W !,$$REPEAT^XLFSTR("-",79),!
|
|---|
| 78 | S RMPRPAGE=RMPRPAGE+1 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | TYPE S FO=$P(^RMPR(668,RZ,0),U,8) W ?48,$S(FO=1:"ROUTINE",FO=2:"EYEGLASS",FO=3:"CONTACT LENS",FO=4:"OXYGEN",FO=5:"MANUAL",1:"") Q
|
|---|
