- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOBIL5.m
r613 r623 1 RMPOBIL5 ;(NG)/DUG - HOME OXYGEN BILLING TRANSACTIONS ;7/24/98 2 ;;3.0;PROSTHETICS;**29,99,137**;Feb 09, 1996;Build 5 3 N RMPRMERG S RMPRMERG=0 4 S (RC,RA,AN,ANS,RK,RZ)=0 D HDR 5 F S RA=$O(^RMPR(660,"AC",RMPRDFN,RA)) Q:RA="" D 6 . S AN="" 7 . F S AN=$O(^RMPR(660,"AC",RMPRDFN,RA,AN)) Q:AN="" D 8 . . I $D(^RMPO(665.72,"AC",AN))>0 S RC=RC+1,IT(RC)=AN 9 ;Check for merged accounts 10 I $D(^XDRM("B",RMPRDFN_";DPT(")) D 11 . S RMPRMERG=$O(^XDRM("B",RMPRDFN_";DPT(",RMPRMERG)) Q:RMPRMERG="" 12 . S RMPRMERG=+^XDRM(RMPRMERG,0) Q:RMPRMERG=0 D 13 .. S RA=0 14 .. F S RA=$O(^RMPR(660,"AC",RMPRMERG,RA)) Q:RA="" D 15 ... S AN="" 16 ... F S AN=$O(^RMPR(660,"AC",RMPRMERG,RA,AN)) Q:AN="" D 17 .... I $D(^RMPO(665.72,"AC",AN))>0 S RC=RC+1,IT(RC)=AN 18 G:'$D(IT) END 19 DIS ;DISPLAY APPLIANCES OR REPAIRS 20 I $G(RK)="" S (RC,RK)="" 21 I RK+1'>RC S RK=RK+1,AN=+IT(RK) D G:$$XIT EXIT G DIS 22 . S Y=^RMPR(660,AN,0) D PRT,OVER:((IOSL-4)<$Y) 23 END I RC=0 W !,"No home oxygen items for this veteran!",!! H 3 G EXIT 24 E D G EXIT 25 .I RC>0 D I $G(RK)+1'>$G(RC) D DIS 26 . . W !!,"End of Home Oxygen records for this veteran!" D OVER 27 .I $G(RC)="" Q 28 EXIT Q:'$D(RMPRDFN) 29 W ! K I,J,L,R0,IT,RA 30 I $D(DUOUT)!($D(DTOUT)) G ASK1^RMPRPAT 31 S FL=4 G ASK2^RMPRPAT 32 K RMPRCNUM,TRANS,TRANS1,TYPE,VEN 33 K AMIS,AN,CST,DATE,DEL,DUOUT,DTOUT,FL,FRM,PAGE,QTY,RC,REM,RZ,RK,SN,STA 34 Q 35 XIT() Q '$D(ANS)!(ANS=U)!($D(DUOUT))!($D(DTOUT)) 36 PRT S DATE=$P(Y,U,3),TYPE=$P(Y,U,6),QTY=$P(Y,U,7) 37 S VEN=$P(Y,U,9),TRANS=$P(Y,U,4),STA=$P(Y,U,10),SN=$P(Y,U,11) 38 S DEL=$P(Y,U,12) 39 S CST=$S($P(Y,U,16)'="":$P(Y,U,16),$D(^RMPR(660,AN,"LB")):$P(^RMPR(660,AN,"LB"),U,9),1:"") 40 ;form requested on 41 S FRM=$P(Y,U,13),REM=$P(Y,U,18) 42 S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) 43 ;S TYPE=$S(TYPE="":"",$D(^RMPR(661,TYPE,0)):$P(^(0),U,1),1:"") 44 S TYPE=$P($G(^RMPR(660,AN,1)),U,4) 45 S AMIS=$P(Y,U,15),VEN=$S(VEN="":"",$D(^PRC(440,VEN,0)):$P(^(0),U,1),1:"") 46 I $D(^RMPR(660.1,"AC",AN)),$P(^RMPR(660.1,$O(^RMPR(660.1,"AC",AN,0)),0),U,11)]"" S AMIS=AMIS_"+" 47 S TRANS=$S(TRANS]"":TRANS,1:""),TRANS1="" 48 S:TRANS="X" TRANS1=TRANS,TRANS="" 49 S DEL=$E(DEL,4,5)_"/"_$E(DEL,6,7)_"/"_$E(DEL,2,3) S:DEL="//" DEL="" 50 W !,RK,". ",DATE,?13,QTY,?17 51 ;W AMIS_$S(TYPE'="":$E($P(^PRC(441,TYPE,0),U,2),1,10),$P(Y,U,26)="D":"DELIVERY",$P(Y,U,26)="P":"PICKUP",$P(Y,U,17):"SHIPPING",1:"") 52 W AMIS_$S(TYPE'="":$E($P($G(^RMPR(661.1,TYPE,0)),U,2),1,10),$P(Y,U,26)="D":"DELIVERY",$P(Y,U,26)="P":"PICKUP",$P(Y,U,17):"SHIPPING",1:"") 53 ;W:$D(^RMPR(660,$P(IT(RK),U,1),"HST")) $E($P(^("HST"),U,1),1,10) 54 I TYPE=""&($D(^RMPR(660,$P(IT(RK),U,1),"HST"))) W $E($P(^("HST"),U,1),1,10) 55 W ?30,TRANS,?31,TRANS1 56 ;display source of procurement for 2529-3 under vendor header 57 I $D(RMPRLPRO) W ?33,RMPRLPRO 58 K RMPRLPRO 59 I VEN'="" W ?33,$E(VEN,1,10) 60 W:$D(^RMPR(660,$P(IT(RK),U,1),"HST")) $E($P(^("HST"),U,3),1,10) 61 W:STA'="" ?45,$P(^DIC(4,STA,99),U,1) 62 W ?50,$E(SN,1,9),?60,DEL 63 W ?71,$J($FN($S(CST'="":CST,$P(Y,U,17):$P(Y,U,17),1:""),"T",2),9) 64 W:REM]"" !,?3,REM 65 I $P(IT(RK),U,2)="" S IT(RK)=IT(RK)_"^"_RZ 66 Q 67 OVER N ANS 68 S RZ=RK W !,"+=Turned-In *=Historical Data I=Initial X=Repair S=Spare R=Replacement",!,"Enter 1-",RK," to show full entry, '^' to exit or `return` to continue. " R ANS:DTIME S:'$T ANS="^" 69 I ANS="^^" S ANS="^" G ASK1^RMPRPAT Q 70 I ANS="^" G ASK1^RMPRPAT Q 71 I ANS="",RK+1'>RC D HDR Q 72 I ANS="" Q 73 I ANS'?1N.N!(ANS>RK)!(+ANS=0)!(+ANS'=ANS) W $C(7),!," Must be between 1 and ",RK," to be valid" G OVER 74 I ANS>0,(ANS<(RK+1)) S AN=ANS,RZ=RK D ^RMPRPAT3 75 S RK=$P(IT(ANS),U,2) 76 Q 77 HDR ;Print Header, Screen 4 78 W @IOF 79 S PAGE=3 80 W !,$E(RMPRNAM,1,20),?23,"SSN: " 81 W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10) 82 W ?42,"DOB: " 83 S Y=RMPRDOB X ^DD("DD") W Y K Y 84 W ?61,"CLAIM# ",$G(RMPRCNUM) 85 W !?4,"Date",?12,"Qty",?19,"HCPCS",?28,"Type",?34,"Vendor",?45,"Sta",?50,"Serial",?58,"Delivery Date",?72,"Tot Cost" 86 Q 1 RMPOBIL5 ;(NG)/DUG - HOME OXYGEN BILLING TRANSACTIONS ;7/24/98 2 ;;3.0;PROSTHETICS;**29,99**;Feb 09, 1996 3 S (RC,RA,AN,ANS,RK,RZ)=0 D HDR 4 F S RA=$O(^RMPR(660,"AC",RMPRDFN,RA)) Q:RA="" D 5 . S AN="" 6 . F S AN=$O(^RMPR(660,"AC",RMPRDFN,RA,AN)) Q:AN="" D 7 . . I $D(^RMPO(665.72,"AC",AN))>0 S RC=RC+1,IT(RC)=AN 8 G:'$D(IT) END 9 DIS ;DISPLAY APPLIANCES OR REPAIRS 10 I $G(RK)="" S (RC,RK)="" 11 I RK+1'>RC S RK=RK+1,AN=+IT(RK) D G:$$XIT EXIT G DIS 12 . S Y=^RMPR(660,AN,0) D PRT,OVER:((IOSL-4)<$Y) 13 END I RC=0 W !,"No home oxygen items for this veteran!",!! H 3 G EXIT 14 E D G EXIT 15 .I RC>0 D I $G(RK)+1'>$G(RC) D DIS 16 . . W !!,"End of Home Oxygen records for this veteran!" D OVER 17 .I $G(RC)="" Q 18 EXIT Q:'$D(RMPRDFN) 19 W ! K I,J,L,R0,IT,RA 20 I $D(DUOUT)!($D(DTOUT)) G ASK1^RMPRPAT 21 S FL=4 G ASK2^RMPRPAT 22 K RMPRCNUM,TRANS,TRANS1,TYPE,VEN 23 K AMIS,AN,CST,DATE,DEL,DUOUT,DTOUT,FL,FRM,PAGE,QTY,RC,REM,RZ,RK,SN,STA 24 Q 25 XIT() Q '$D(ANS)!(ANS=U)!($D(DUOUT))!($D(DTOUT)) 26 PRT S DATE=$P(Y,U,3),TYPE=$P(Y,U,6),QTY=$P(Y,U,7) 27 S VEN=$P(Y,U,9),TRANS=$P(Y,U,4),STA=$P(Y,U,10),SN=$P(Y,U,11) 28 S DEL=$P(Y,U,12) 29 S CST=$S($P(Y,U,16)'="":$P(Y,U,16),$D(^RMPR(660,AN,"LB")):$P(^RMPR(660,AN,"LB"),U,9),1:"") 30 ;form requested on 31 S FRM=$P(Y,U,13),REM=$P(Y,U,18) 32 S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) 33 ;S TYPE=$S(TYPE="":"",$D(^RMPR(661,TYPE,0)):$P(^(0),U,1),1:"") 34 S TYPE=$P($G(^RMPR(660,AN,1)),U,4) 35 S AMIS=$P(Y,U,15),VEN=$S(VEN="":"",$D(^PRC(440,VEN,0)):$P(^(0),U,1),1:"") 36 I $D(^RMPR(660.1,"AC",AN)),$P(^RMPR(660.1,$O(^RMPR(660.1,"AC",AN,0)),0),U,11)]"" S AMIS=AMIS_"+" 37 S TRANS=$S(TRANS]"":TRANS,1:""),TRANS1="" 38 S:TRANS="X" TRANS1=TRANS,TRANS="" 39 S DEL=$E(DEL,4,5)_"/"_$E(DEL,6,7)_"/"_$E(DEL,2,3) S:DEL="//" DEL="" 40 W !,RK,". ",DATE,?13,QTY,?17 41 ;W AMIS_$S(TYPE'="":$E($P(^PRC(441,TYPE,0),U,2),1,10),$P(Y,U,26)="D":"DELIVERY",$P(Y,U,26)="P":"PICKUP",$P(Y,U,17):"SHIPPING",1:"") 42 W AMIS_$S(TYPE'="":$E($P($G(^RMPR(661.1,TYPE,0)),U,2),1,10),$P(Y,U,26)="D":"DELIVERY",$P(Y,U,26)="P":"PICKUP",$P(Y,U,17):"SHIPPING",1:"") 43 ;W:$D(^RMPR(660,$P(IT(RK),U,1),"HST")) $E($P(^("HST"),U,1),1,10) 44 I TYPE=""&($D(^RMPR(660,$P(IT(RK),U,1),"HST"))) W $E($P(^("HST"),U,1),1,10) 45 W ?30,TRANS,?31,TRANS1 46 ;display source of procurement for 2529-3 under vendor header 47 I $D(RMPRLPRO) W ?33,RMPRLPRO 48 K RMPRLPRO 49 I VEN'="" W ?33,$E(VEN,1,10) 50 W:$D(^RMPR(660,$P(IT(RK),U,1),"HST")) $E($P(^("HST"),U,3),1,10) 51 W:STA'="" ?45,$P(^DIC(4,STA,99),U,1) 52 W ?50,$E(SN,1,9),?60,DEL 53 W ?71,$J($FN($S(CST'="":CST,$P(Y,U,17):$P(Y,U,17),1:""),"T",2),9) 54 W:REM]"" !,?3,REM 55 I $P(IT(RK),U,2)="" S IT(RK)=IT(RK)_"^"_RZ 56 Q 57 OVER N ANS 58 S RZ=RK W !,"+=Turned-In *=Historical Data I=Initial X=Repair S=Spare R=Replacement",!,"Enter 1-",RK," to show full entry, '^' to exit or `return` to continue. " R ANS:DTIME S:'$T ANS="^" 59 I ANS="^^" S ANS="^" G ASK1^RMPRPAT Q 60 I ANS="^" G ASK1^RMPRPAT Q 61 I ANS="",RK+1'>RC D HDR Q 62 I ANS="" Q 63 I ANS'?1N.N!(ANS>RK)!(+ANS=0)!(+ANS'=ANS) W $C(7),!," Must be between 1 and ",RK," to be valid" G OVER 64 I ANS>0,(ANS<(RK+1)) S AN=ANS,RZ=RK D ^RMPRPAT3 65 S RK=$P(IT(ANS),U,2) 66 Q 67 HDR ;Print Header, Screen 4 68 W @IOF 69 S PAGE=3 70 W !,$E(RMPRNAM,1,20),?23,"SSN: " 71 W $E(RMPRSSN,1,3)_"-"_$E(RMPRSSN,4,5)_"-"_$E(RMPRSSN,6,10) 72 W ?42,"DOB: " 73 S Y=RMPRDOB X ^DD("DD") W Y K Y 74 W ?61,"CLAIM# ",$G(RMPRCNUM) 75 W !?4,"Date",?12,"Qty",?19,"HCPCS",?28,"Type",?34,"Vendor",?45,"Sta",?50,"Serial",?58,"Delivery Date",?72,"Tot Cost" 76 Q
Note:
See TracChangeset
for help on using the changeset viewer.
