| 1 | RMPORPD ;(NG)/DG/CAP/HINES CIOFO/HNC -PRESCRIPTION EXPIRE DATE ACTIVE PATIENTS ; 5/19/00 9:12am
|
|---|
| 2 | ;;3.0;PROSTHETICS;**29,46,49**;Feb 09, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | SITE ; Set up the site variables.
|
|---|
| 5 | D HOSITE^RMPOUTL0 Q:'$D(RMPOXITE)
|
|---|
| 6 | ;
|
|---|
| 7 | LI ; List the sought patient.
|
|---|
| 8 | N WHO S WHO=0
|
|---|
| 9 | S (RMEND,RMPORPT,PAGE,COUNT)=0
|
|---|
| 10 | D NOW^%DTC S Y=% X ^DD("DD")
|
|---|
| 11 | S RPTDT=$P(Y,"@",1)_" "_$P($P(Y,"@",2),":",1,2)
|
|---|
| 12 | ;
|
|---|
| 13 | S DIC="^RMPR(665,"
|
|---|
| 14 | S BY(0)="^TMP(""RMPO"",$J,",L(0)=3,L=0,FR=""
|
|---|
| 15 | S DIS(0)="I $P($G(^RMPR(665,D0,""RMPOA"")),U,7)=RMPOXITE,$P($G(^RMPR(665,D0,""RMPOA"")),U,2)'="""",$P($G(^RMPR(665,D0,""RMPOA"")),U,3)="""""
|
|---|
| 16 | S DHIT="D CNT^RMPORPD"
|
|---|
| 17 | S DHD="W ?0 D RPTHDR^RMPORPD"
|
|---|
| 18 | S DIOEND="I $G(Y)'[U W !!,?50,""Total Patients: "",$J(COUNT,6) S RMEND=1 S:IOST[""P-"" RMPORPT=1"
|
|---|
| 19 | S FLDS="W $$RXDT^RMPORPD();C1;L10"
|
|---|
| 20 | S FLDS(1)=".01;C12;L22"
|
|---|
| 21 | S FLDS(2)="W $$SSN^RMPORPD();C36;L4"
|
|---|
| 22 | S FLDS(3)="W $$PITEM^RMPORPD();C41;L30"
|
|---|
| 23 | S FLDS(4)="W $$ACTDT^RMPORPD();C73;L8"
|
|---|
| 24 | D PRESORT,EN1^DIP
|
|---|
| 25 | I RMPORPT=0,$G(RMEND) K DIR S DIR(0)="E" D ^DIR
|
|---|
| 26 | ;
|
|---|
| 27 | EXIT ;
|
|---|
| 28 | K ^TMP("RMPO",$J) N RMPRSITE,RMPR D KILL^XUSCLEAN
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ACTDT() ;*** ACTIVATION DATE
|
|---|
| 32 | S X=$P($G(^RMPR(665,D0,"RMPOA")),U,2)
|
|---|
| 33 | S:X X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|---|
| 34 | Q X
|
|---|
| 35 | ;
|
|---|
| 36 | CNT ;*** COUNT NAMES
|
|---|
| 37 | I WHO'=D0 S COUNT=COUNT+1
|
|---|
| 38 | S WHO=D0
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | ;*** CONVERT DATE FROM FILEMAN FORMAT TO MM/DD/YYYY
|
|---|
| 42 | DATE(FMD) ;
|
|---|
| 43 | Q $E(FMD,4,5)_"/"_$E(FMD,6,7)_"/"_($E(FMD,1,3)+1700)
|
|---|
| 44 | ;
|
|---|
| 45 | PITEM() ;*** GET PRIMARY ITEM AND ACTIVATION DATE
|
|---|
| 46 | N PITM,E
|
|---|
| 47 | S (E,PITM)=0,X=""
|
|---|
| 48 | F S PITM=$O(^RMPR(665,D0,"RMPOC",PITM)) Q:'PITM D Q:E
|
|---|
| 49 | . S PDT=^RMPR(665,D0,"RMPOC",PITM,0)
|
|---|
| 50 | . Q:$P(PDT,U,11)'="Y"
|
|---|
| 51 | . S X=$P(PDT,U),X=$P(^RMPR(661,X,0),U)
|
|---|
| 52 | . S X=$P($G(^PRC(441,X,0)),U,2)
|
|---|
| 53 | . S X=$E(X,1,30),E=1
|
|---|
| 54 | Q X
|
|---|
| 55 | ;
|
|---|
| 56 | PRESORT ;*** SORT BY EXPIRATION DATE
|
|---|
| 57 | N D0,D2,DFN
|
|---|
| 58 | K ^TMP("RMPO",$J)
|
|---|
| 59 | S D2=0
|
|---|
| 60 | F S D2=$O(^RMPR(665,"AHO",D2)) Q:'D2 S D0="" D
|
|---|
| 61 | . F S D0=$O(^RMPR(665,"AHO",D2,D0)) Q:D0="" D
|
|---|
| 62 | . . K VAPA,VADM S DFN=D0 D ^VADPT
|
|---|
| 63 | . . S ^TMP("RMPO",$J,$$RXDT(1),VADM(1),D0)=""
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | RPTHDR ;*** REPORT HEADER
|
|---|
| 67 | N RA S RA=RMPO("NAME"),PAGE=PAGE+1
|
|---|
| 68 | W RPTDT,?(40-($L(RA)/2)),RA,?68,"Page: "_PAGE
|
|---|
| 69 | W !?20,"Prescription Expiration Date",!,"Date Current",!,"Prescription"
|
|---|
| 70 | W !?1,"Expires",?11,"Name",?35,"SSN",?41,"Primary Item",?73,"Active"
|
|---|
| 71 | W !,"==========",?11,"=======================",?35,"====",?41,"==============================",?72,"========",!
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | ;*** EXPIRATION DATE OF CURRENT RX
|
|---|
| 75 | ; MODE Date format: 0 - MM/DD/YYYY or "N/A" (default)
|
|---|
| 76 | ; 1 - YYYMMDD or "N/A"
|
|---|
| 77 | RXDT(MODE) ;
|
|---|
| 78 | N J,D,Y,RA S (D,RA,Y)=""
|
|---|
| 79 | F S D=$O(^RMPR(665,D0,"RMPOB","B",D)) Q:D="" D
|
|---|
| 80 | . S J=$O(^RMPR(665,D0,"RMPOB","B",D,""),-1) Q:J="" S:J>RA RA=J
|
|---|
| 81 | S:RA'="" Y=$P($G(^RMPR(665,D0,"RMPOB",RA,0)),U,3)
|
|---|
| 82 | S X=$S('Y:"N/A",'$G(MODE):$$DATE(Y),1:Y)
|
|---|
| 83 | Q X
|
|---|
| 84 | ;
|
|---|
| 85 | SSN() ;*** SOCIAL SECURITY NUMBER
|
|---|
| 86 | K VA,VADM
|
|---|
| 87 | S DFN=D0 D ^VADPT
|
|---|
| 88 | S X=$P(VA("PID"),"-",3)
|
|---|
| 89 | Q X
|
|---|
