| [628] | 1 | RMPORNQ ;(VA-EDS)PAK/HINES CIOFO/HNC - NEW PATIENT REPORT ;7/24/98
|
|---|
| 2 | ;;3.0;PROSTHETICS;**29,77**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | ;RVD patch #77 - insure that a dangling 'AC' x-ref will not cause
|
|---|
| 5 | ; an undefined error.
|
|---|
| 6 | ;
|
|---|
| 7 | START ;
|
|---|
| 8 | ;Set up site variables.
|
|---|
| 9 | D HOSITE^RMPOUTL0 I '$D(RMPOXITE) Q
|
|---|
| 10 | ;
|
|---|
| 11 | ;Ask starting date
|
|---|
| 12 | S %DT="AEX",%DT("A")="Enter the start date: "
|
|---|
| 13 | S %DT(0)=-DT
|
|---|
| 14 | S %DT("B")=$E(DT,4,5)_"/01"_"/"_$E(DT,2,3)
|
|---|
| 15 | D ^%DT Q:'Y!$D(DTOUT)
|
|---|
| 16 | S FRMDT=$P(Y,".") ; extract ONLY date
|
|---|
| 17 | ;
|
|---|
| 18 | ;List the sought patient.
|
|---|
| 19 | S DIC="^RMPR(665,",L=0
|
|---|
| 20 | S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE"
|
|---|
| 21 | S BY=".01,19.2",FR(1)="",FR(2)=FRMDT,TO(1)="",TO(2)=""
|
|---|
| 22 | S (RMEND,RMPORPT,PAGE)=0
|
|---|
| 23 | S SPACE="",$P(SPACE," ",80)="",COUNT=0,DASH="",$P(DASH,"-",79)=""
|
|---|
| 24 | D NOW^%DTC S Y=% X ^DD("DD") S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 25 | S DHD="W ?0 D RPTHDR^RMPORNQ"
|
|---|
| 26 | S FLDS=".01;C1;L22;""PATIENT"",W $$SSN^RMPORPR;C25;R4;""SSN"",W $$PRI^RMPORNQ;31;L32;""PRIMARY ITEM"",19.2;C65;L10;""START"""
|
|---|
| 27 | S DIOEND="I $G(Y)'[U S COUNT=$E("" "",1,(6-$L(COUNT)))_COUNT W !!,?50,""TOTAL PATIENTS: "",COUNT S RMEND=1 S:IOST[""P-"" RMPORPT=1"
|
|---|
| 28 | D EN1^DIP
|
|---|
| 29 | I RMPORPT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
|
|---|
| 30 | EXIT ;
|
|---|
| 31 | ;
|
|---|
| 32 | N RMPR,RMPRSITE D KILL^XUSCLEAN
|
|---|
| 33 | Q
|
|---|
| 34 | SDT ;Activation date.
|
|---|
| 35 | S X=$P($G(^RMPR(665,D0,"RMPOA")),U,2)
|
|---|
| 36 | I X S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | PRI() ;Get primary item.
|
|---|
| 40 | N ITMN
|
|---|
| 41 | ;
|
|---|
| 42 | S RMPOITM=$O(^RMPR(665,"AC","Y",D0,"")) Q:RMPOITM="" ""
|
|---|
| 43 | ; get item name from ITEM MASTER file as pointer field is DINUMed
|
|---|
| 44 | I '$D(^RMPR(665,D0,"RMPOC",RMPOITM,0)) Q ""
|
|---|
| 45 | S ITMN=$P(^RMPR(665,D0,"RMPOC",RMPOITM,0),U)
|
|---|
| 46 | S ITMN=$P(^RMPR(661,ITMN,0),U)
|
|---|
| 47 | S ITMN=$P(^PRC(441,ITMN,0),U,2)
|
|---|
| 48 | Q $E(ITMN,1,32)
|
|---|
| 49 | ;
|
|---|
| 50 | RPTHDR ;Report header
|
|---|
| 51 | N RA S RA=RMPO("NAME"),PAGE=PAGE+1
|
|---|
| 52 | W RPTDT,?(40-($L(RA)/2)),RA,?65,"Page: "_PAGE
|
|---|
| 53 | W !?24,"New Patient Report",!
|
|---|
| 54 | W !,?4,"Patient",?24,"SSN",?39,"Primary Item",?64,"Activation Date"
|
|---|
| 55 | W !,"=====================",?24,"====",?30,"================================"
|
|---|
| 56 | W ?64,"===============",!
|
|---|
| 57 | Q
|
|---|
