source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDT10.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1RMPFDT10 ;DDC/KAW-LINE ITEM EXTENDED INFORMATION [ 06/16/95 3:06 PM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
3 ;; input: RMPFX
4 ;;output: None
5 S DFN=$P(^RMPF(791810,RMPFX,0),U,4) G END:'DFN D PAT^RMPFUTL K RMPFY
6 D SEL G END:$D(RMPFOUT),END:'$D(RMPFY)
7SHOW D HEAD,SET,DISP
8 I IOST?1"C-".E D CONT G RMPFDT10:RMPFCT>1
9 I IOST?1"P-".E W @IOF
10 D:$D(IO("S")) ^%ZISC
11END K DFN,RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,X,Y,I,RMPFOUT,RMPFQUT,%XX,%YY
12 K RMPFMD,RMPFO,RMPFTYP,RMPFHAT,ZTSK,XX,CX,RMPFY,CT,RR,RMPFCT
13 Q
14SET ;; input: RMPFX,RMPFY
15 ;;output: None
16 S SX=$G(^RMPF(791810,RMPFX,101,RMPFY,90))
17 S AU=$P(SX,U,1) I AU,$D(^VA(200,AU,0)) S AU=$P(^(0),U,1)
18 S AD=$P(SX,U,2) I AD S Y=AD D DD^%DT S AD=Y
19 S AR=$P(SX,U,3),AM=$P(SX,U,4)
20 S CR=$P(SX,U,5),DR=$P(SX,U,6) I DR S Y=DR D DD^%DT S DR=Y
21 S UC=$P(SX,U,13) I UC,$D(^VA(200,UC,0)) S UC=$P(^(0),U,1)
22 S SD=$P(SX,U,7) I SD S Y=SD D DD^%DT S SD=Y
23 S CU=$P(SX,U,8) I CU,$D(^VA(200,CU,0)) S CU=$P(^(0),U,1)
24 S CD=$P(SX,U,9) I CD S Y=CD D DD^%DT S CD=Y
25 S RC=$P(SX,U,10) I RC,$D(^VA(200,RC,0)) S RC=$P(^(0),U,1)
26 S RD=$P(SX,U,11) I RD S Y=RD D DD^%DT S RD=Y
27 S IU=$P(SX,U,12) I IU,$D(^VA(200,IU,0)) S IU=$P(^(0),U,1)
28 S OD=$P(SX,U,14) I OD,$D(^RMPF(791810.6,OD,0)) S OD=$P(^(0),U,1)
29 I OD="OTHER",$P(SX,U,15)'="" S OD=$P(SX,U,15)
30 S SX=$G(^RMPF(791810,RMPFX,101,RMPFY,2)),RR=$P(SX,U,7)
31 K SX Q
32DISP ;; input: AU,AD,AR,AM,CR,DR,SD,CU,CD,RC,RD,IU,UC,OD
33 ;;output: None
34 S XX=$Y G DI1:AU=""
35 W !!,"User Making Last Adjustment: ",AU
36 W !?4,"Date of Last Adjustment: ",AD
37 W !?6,"Reason for Adjustment: ",AR
38 W !?9,"Adjustment Message: ",AM
39DI1 G DI2:UC=""&(CR="") W !!?16,"Canceled By: ",UC
40 W:CR'="" !?14,"Cancel Reason: ",CR
41DI2 W:DR'="" !?4,"Date Returned to Vendor: ",DR
42 W:SD'="" !?18,"Ship Date: ",SD
43 G DI3:CU=""
44 W !!?15,"Certified By: ",CU
45 W !?9,"Certification Date: ",CD
46 W !?12,"Re-certified By: ",RC
47 W !?6,"Re-certification Date: ",RD
48DI3 W:IU'="" !?18,"Issued By: ",IU
49 W:OD'="" !?11,"Reason for Delay: ",OD
50 W:RR'="" !?4,"Reason for Registration: ",RR
51 I $Y=XX W !!?9,"*** NO ADDITIONAL INFORMATION AVAILABLE FOR THIS LINE ITEM ***"
52 K AU,AD,AR,AM,CR,DR,SD,CU,CD,IU,RD,RC,UC,XX,OD Q
53SEL D ARRAY^RMPFDT2 S (RMPFCT,X)=0 F S X=$O(RMPFO(X)) Q:'X S RMPFY=X,RMPFCT=RMPFCT+1
54 Q:RMPFCT=1
55 S RMPFTYP=$P(^RMPF(791810,RMPFX,0),U,2),RMPFHAT=""
56 I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2)
57 W @IOF,!?33,"ITEMS ORDERED" D @("HEADP"_"^RMPFDT1")
58 D ^RMPFDT2
59S1 F Q:$Y>21 W !
60 W !,"Select number of a line item or <RETURN> to continue: " D READ
61 Q:$D(RMPFOUT)
62S2 I $D(RMPFQUT) W !!,"Select a number from the left of the display to choose a line item or",!,"<RETURN> to exit from the display." G S1
63 Q:Y="" I '$D(RMPFMD(Y)) S RMPFQUT="" G S2
64 S RMPFY=RMPFMD(Y) Q
65 Q
66HEAD W:'$D(ZTSK) @IOF W !?22,"ROES LINE ITEM EXTENDED INFORMATION"
67 I $D(RMPFNAM) W !,"Patient: ",$E(RMPFNAM,1,25),?35,"SSN: ",RMPFSSN,?68,RMPFDAT
68 W ! F I=1:1:80 W "-"
69 W ! Q
70CONT F I=1:1 Q:$Y>20 W !
71 W !,"Type <RETURN> to continue, <P>rint or <^> to exit: " D READ
72 Q:$D(RMPFOUT) G CONT:$D(RMPFQUT)
73 D QUE:Y="P"
74 Q
75QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
76 I IO=IO(0),'$D(IO("S")) D SHOW^RMPFDT10 G QUEE
77 I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G SHOW^RMPFDT10
78 S ZTRTN="SHOW^RMPFDT10",ZTSAVE("RMPF*")="",ZTSAVE("DFN")=""
79 S ZTIO=ION D ^%ZTLOAD
80 D HOME^%ZIS S RMPFOUT=""
81 W:$D(ZTSK) !!,"*** Request Queued ***" H 1
82QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
83READ K RMPFOUT,RMPFQUT
84 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
85 I Y?1"^".E S (RMPFOUT,Y)="" Q
86 S:Y?1"?".E (RMPFQUT,Y)=""
87 Q
88 K ZTSK Q
Note: See TracBrowser for help on using the repository browser.