Changeset 623 for WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRD1.m
- 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/RMPRD1.m
r613 r623 1 RMPRD1 2 ;;3.0;PROSTHETICS;**38,141**;Feb 09, 1996;Build 5 3 EN 4 5 6 7 8 9 10 11 12 EN1 13 14 15 16 17 18 19 20 21 22 23 24 ..S RMPRIT=$P($G(^RMPR(661,RMPRI1,0)),U,1)25 ..S:RMPRIT RMPRN=$P(^PRC(441,RMPRIT,0),U,2) S:RMPRIT="" RMPRN="*MASTER ITEM DELETED*" 26 27 28 29 30 EN2 31 32 33 EN3 34 35 36 37 38 39 EN4 40 41 42 43 44 EN5 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 EN6 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 EXIT 117 118 1 RMPRD1 ;PHX/HNB-DISPLAY LOOKUP ;10/19/1993 [ 06/28/94 3:17 PM ]<<= NOT VERIFIED > 2 ;;3.0;PROSTHETICS;**38**;Feb 09, 1996 3 EN ;DISPLAY DATE,PATIENT,ITEM,COST FROM 660 4 S Z=^RMPR(660,+Y,0) 5 S RMPRIT=$P(Z,U,6) 6 I RMPRIT'="" S RMPRIT=$P(^RMPR(661,RMPRIT,0),U,1),RMPRIT=$P(^PRC(441,RMPRIT,0),U,2) 7 I RMPRIT="" S RMPRIT=$S($P(^RMPR(660,+Y,0),U,26)="P":"SHIPPING",$P(^RMPR(660,+Y,0),U,26)="D":"DELIVERY",1:"SHIPPING") 8 S RMPRCST="$"_$J($FN($P(Z,U,16),"T",2),8) 9 W ?36,$E(RMPRIT,1,23),?70,RMPRCST 10 K RMPRDFN,RMPRNAM,RMPRIT,RMPRCST,Z 11 Q 12 EN1 ;DISPLAY DATE,REFERENCE,PATIENT FROM 664 13 Q:$G(RMPRQT)=1 14 I $G(DIC)="^RMPR(664," S Z=^RMPR(664,+Y,0),ZZ=$P(Z,U,7) 15 W:$P(Z,U,8) ?40,"Closed" W:$P(Z,U,5) ?40,"Cancelled" 16 W:$G(ZZ)'="" ?51,"REF: ",$P(ZZ,"-",3) 17 I $G(ZZ)="",$P(Z,U,15),$D(^RMPR(664.2,+$P(Z,U,15),0)) W ?40,$P(^(0),U) 18 I $D(^RMPR(664,+Y,1,0)) D 19 .S RMPRI=0 20 .;F S RMPRI=$O(^RMPR(664,+Y,1,RMPRI)) Q:$G(RMPRI)'>0 21 .;S RMPRI1=$P(^RMPR(664,+Y,1,RMPRI,0),U,1) 22 .F S RMPRI=$O(^RMPR(664,+Y,1,RMPRI)) Q:$G(RMPRI)'>0 D 23 ..S RMPRI1=$P(^RMPR(664,+Y,1,RMPRI,0),U,1) Q:$G(RMPRI1)'>0 24 ..S RMPRIT=$P(^RMPR(661,RMPRI1,0),U,1) 25 ..S RMPRN=$P(^PRC(441,RMPRIT,0),U,2) 26 ..W ?64,$E(RMPRN,1,15) 27 ..I $O(^RMPR(664,+Y,1,RMPRI)) W ! 28 I '$D(^RMPR(664,+Y,1)),$P(^RMPR(664,+Y,0),U,12) W ?64,"PICKUP/DELIVERY",! 29 K ZZ Q 30 EN2 ;DISPLAY NAME 31 I DIC="^RMPR(664," S Z=$P(^RMPR(664,+Y,0),U,2) I +Z W ?20,$E($P(^DPT(+Z,0),U,1),1,15) G EN1 32 Q 33 EN3 ;DISPLAY LAB ORDER 34 I $P(^RMPR(664.1,+Y,0),U,13)="" D EN4 Q 35 S Z=$P(^RMPR(664.1,+Y,0),U,2) 36 I +Z W ?20,$E($P(^DPT(+Z,0),U,1),1,15),?40,$P(^RMPR(664.1,+Y,0),U,13),?57,$P(^(0),U,17) I $D(^RMPR(664.1,+Y,2)) D 37 .F RMPRI=0:0 S RMPRI=$O(^RMPR(664.1,+Y,2,RMPRI)) Q:RMPRI'>0 I $D(^(RMPRI,0)) S ZA=$P(^(0),U,1) W ?64,$E($$ITM^RMPR31U(ZA),1,15) I $O(^RMPR(664.1,+Y,2,RMPRI)) W ! 38 Q 39 EN4 ;DISPLAY 2529-3 REQUEST 40 S Z=^RMPR(664.1,+Y,0) 41 I +$P(Z,U,2) W ?20,$E($P(^DPT(+$P(Z,U,2),0),U,1),1,15) S RMPRSC=$P(Z,U,11),ZA=$P(^DD(664.1,2,0),U,3) W:RMPRSC'="" ?40,$E($P($P(ZA,RMPRSC_":",2),";",1),1,15)_"-"_$$STAN^RMPR31U($P(Z,U,15)) I $D(^RMPR(664.1,+Y,2)) D 42 .F RMPRI=0:0 S RMPRI=$O(^RMPR(664.1,+Y,2,RMPRI)) Q:RMPRI'>0 I $D(^(RMPRI,0)) S ZA=$P(^(0),U,1) W ?64,$E($$ITM^RMPR31U(ZA),1,15) I $O(^RMPR(664.1,+Y,2,RMPRI)) W ! 43 Q 44 EN5 ;Inquire to 1358 transaction 45 I '$D(RMPR) D DIV4^RMPRSIT Q:$D(X) 46 N DIC 47 S RMPRQT=1 48 S DIC="^RMPR(664,",DIC(0)="AEQMZ" ;,DIC("W")="D EN2^RMPRD1" 49 ;S %ZIS="MQ" D ^%ZIS G:POP EXIT 50 K IOP I $E(IOST,1,1)["C-" G EN6 51 S DIC("S")="I $P(^(0),U,14)=RMPR(""STA"")" 52 D ^DIC Q:Y'>0 53 S RMPRDA=+Y 54 S %ZIS="MQ" D ^%ZIS G:POP EXIT 55 I $D(IO("Q")) D G EXIT 56 .S ZTSAVE("RMPRDA")="",ZTSAVE("RMPR(")="" 57 .S ZTSAVE("DATE(")="",ZTSAVE("RMPRSITE")="" 58 .S ZTIO=ION,ZTRTN="EN6^RMPRD1",ZTDESC="Inquire To Prosthetics 1358" 59 .D ^%ZTLOAD K ZTDESC,ZTIO,ZTRTN,ZTSAVE 60 ;ENTRY POINT FOR ACTUAL PRINTING OF 1358 INFO TO PRINTER OR SCREEN 61 ;S DIC("S")="I $P(^(0),U,14)=RMPR(""STA"")" 62 ; D ^DIC Q:Y'>0 63 EN6 N RPO,RPO1 K DR 64 S DA=RMPRDA,DIQ="RPO",DR=".01:24",RMPRDA=DA 65 D EN^DIQ1 66 S DR(664.02)=".01:16" 67 S RPO1=0 68 F S RPO1=$O(^RMPR(664,DA,1,RPO1)) Q:RPO1'>0 D 69 .S DA(664.02)=RPO1 70 .D EN^DIQ1 71 ;Display 72 U IO 73 I $Y>1 W @IOF 74 W "Patient: ",RPO(664,RMPRDA,1),?40,"Vendor:",RPO(664,RMPRDA,4) 75 W !,"Request Date: ",RPO(664,RMPRDA,.01),?33,"Date Required: ",RPO(664,RMPRDA,20),?69,"Days: ",RPO(664,RMPRDA,21) 76 W !,"Form: ",RPO(664,RMPRDA,15),?33,"Initiator: ",$E(RPO(664,RMPRDA,10),1,12),?60,"Sta.: ",$E(RPO(664,RMPRDA,18),1,11) 77 I $G(RPO(664,RMPRDA,8))'="" D 78 .W !!,"Close Out Date:",RPO(664,RMPRDA,8),?40,"Closed By:",RPO(664,RMPRDA,8.5) 79 .W !,"Remarks: ",RPO(664,RMPRDA,8.1) 80 I $G(RPO(664,RMPRDA,12))'="" D 81 .W !!,"Shipping Entry: ",RPO(664,RMPRDA,13) 82 .W ?40,"Shipping Charge: ",RPO(664,RMPRDA,12) 83 I $G(RPO(664,RMPRDA,3))'="" D 84 .W !!,"Canceled Date: ",RPO(664,RMPRDA,3),?40,"Canceled By: ",RPO(664,RMPRDA,3.2) 85 .W !,"Cancelation Remarks: ",RPO(664,RMPRDA,3.1) 86 I $G(RPO(664,RMPRDA,22))'="" D 87 .W !!,"Work Order #: ",RPO(664,RMPRDA,22),?33,"Lab Tech.: ",$E(RPO(664,RMPRDA,23),1,12),?60,"Date: ",RPO(664,RMPRDA,24) 88 W !!,"Obligation #:",RPO(664,RMPRDA,.5) 89 W ?35,"C.P.:",RPO(664,RMPRDA,6) 90 W !,"Reference: ",RPO(664,RMPRDA,7) 91 W ?35,"% Discount: ",RPO(664,RMPRDA,17) 92 W ?60,"PSC Category: ",RPO(664,RMPRDA,16) 93 ;Item Mult. Display 94 S RD1=0 F S RD1=$O(^RMPR(664,DA,1,RD1)) Q:$G(RD1)'>0 D 95 .W !!,"Item:",RPO(664.02,RD1,.01) 96 .W ?34,"Qty:",RPO(664.02,RD1,3)_" "_RPO(664.02,RD1,4) 97 .W ?60,"Unit Cost :",RPO(664.02,RD1,2) 98 .W !,?2,"Actual Unit Cost: ",RPO(664.02,RD1,2) 99 .W ?34,"Source:",RPO(664.02,RD1,11) 100 .W ?60,"Serial #:",RPO(664.02,RD1,15) 101 .W !,?2,"Patient Category: ",RPO(664.02,RD1,9),?34,"Type of Transaction: ",RPO(664.02,RD1,9) 102 .W !,?2,"Special Category: ",RPO(664.02,RD1,10),?34,"Appliance/Repair: ",RPO(664.02,RD1,12) 103 .W !!,?2,"Item Remarks: ",RPO(664.02,RD1,7) 104 ;W !!,"READY TO WRITE WORD PROCESSING FIELDS" 105 S RPO1=0 106 F S RPO1=$O(RPO(664.02,RPO1)) Q:RPO1'>0 D 107 .W !,?2,"Brief Description: ",RPO(664.02,RPO1,1) 108 .W !,?2,"Extended Description:" 109 .M RPOD=RPO(664.02,RPO1,14) 110 .D EN^DDIOL(.RPOD) 111 .K RPOD 112 .W !! 113 ;end 114 N DIR 115 I $Y>11&($G(IO("Q"))<1) S DIR(0)="E" D ^DIR 116 EXIT ;EXIT FROM EN5/EN6 117 K DA,RMPRDA,RMPRQT,RPO,IO("Q") 118 D ^%ZISC
Note:
See TracChangeset
for help on using the changeset viewer.
