| [613] | 1 | RMPFDT9 ;DDC/KAW-EXTENDED DISPLAY FOR ROES ORDER [ 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
 | 
|---|
 | 6 |  D HEAD,SET,DISP,CONT:'$D(ZTSK)
 | 
|---|
 | 7 | END K DFN,RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,X,Y,I,RMPFOUT,RMPFQUT,%XX,%YY
 | 
|---|
 | 8 |  K ZTSK Q
 | 
|---|
 | 9 | SET ;; input: RMPFX
 | 
|---|
 | 10 |  ;;output: EC,ED,EE,ET,EU,SE
 | 
|---|
 | 11 |  S SX=$G(^RMPF(791810,RMPFX,2)),SS=$P(SX,U,2)
 | 
|---|
 | 12 |  S EB=$P(SX,U,4),EU=$S('EB&SS:"DETERMINED FROM DATABASE BY ROES",'EB:"",1:$P(SX,U,3))
 | 
|---|
 | 13 |  I EU,$D(^VA(200,EU,0)) S EU=$P(^(0),U,1)
 | 
|---|
 | 14 |  S ED=$P(SX,U,5) I ED S Y=ED D DD^%DT S ED=Y
 | 
|---|
 | 15 |  S SE=$P(SX,U,6) I SE,$D(^RMPF(791810.4,SE,0)) S SE=$P(^(0),U,1)
 | 
|---|
 | 16 |  S EE=$P(SX,U,7) I EE,$D(^VA(200,EE,0)) S EE=$P(^(0),U,1)
 | 
|---|
 | 17 |  S ET=$P(SX,U,8) I ET S Y=ET D DD^%DT S ET=Y
 | 
|---|
 | 18 |  S EC=$P(SX,U,9),SX=$G(^RMPF(791810,RMPFX,10))
 | 
|---|
 | 19 |  K EB,SX,SS Q
 | 
|---|
 | 20 | DISP ;; input: EC,ED,EE,ET,EU,SE
 | 
|---|
 | 21 |  ;;output: None
 | 
|---|
 | 22 |  W !!,"Eligibility Entered By: ",EU
 | 
|---|
 | 23 |  W !!,"Eligibility Entered On: ",ED
 | 
|---|
 | 24 |  W:EC'="" !!?10,"PSAS Comment: ",EC
 | 
|---|
 | 25 |  I SE'="" D
 | 
|---|
 | 26 |  .W !!!?4,"ASPS Proposed Elig: ",SE
 | 
|---|
 | 27 |  .W !!?6,"Elig Proposed By: ",EE
 | 
|---|
 | 28 |  .W !!?4,"Request to PSAS On: ",ET
 | 
|---|
 | 29 |  I IOST?1"P-".E W @IOF
 | 
|---|
 | 30 |  D:$D(IO("S")) ^%ZISC
 | 
|---|
 | 31 |  K EC,ED,EE,ET,EU,SE Q
 | 
|---|
 | 32 | HEAD W:'$D(ZTSK) @IOF W !?24,"ROES ORDER EXTENDED INFORMATION"
 | 
|---|
 | 33 |  I $D(RMPFNAM) W !,"Patient: ",$E(RMPFNAM,1,25),?35,"SSN: ",RMPFSSN,?68,RMPFDAT
 | 
|---|
 | 34 |  W ! F I=1:1:80 W "-"
 | 
|---|
 | 35 |  Q
 | 
|---|
 | 36 | CONT F I=1:1 Q:$Y>20  W !
 | 
|---|
 | 37 |  W !,"Type <RETURN> to continue" W:RMPFMENU=0 ", <L>ine Item View" W " or <P>rint: " D READ
 | 
|---|
 | 38 |  Q:$D(RMPFOUT)
 | 
|---|
 | 39 | C1 I $D(RMPFQUT) D  G CONT
 | 
|---|
 | 40 |  .W !!,"Enter "
 | 
|---|
 | 41 |  .W:RMPFMENU=0 "an <L> to go to the extended line item view",!?6
 | 
|---|
 | 42 |  .W "a <P> to print this screen or",!?6,"<RETURN> to exit."
 | 
|---|
 | 43 |  Q:Y=""  S Y=$E(Y,1) I "LlPp"'[Y S RMPFQUT="" G CONT
 | 
|---|
 | 44 |  I "Pp"[Y D QUE Q
 | 
|---|
 | 45 |  I "Ll"[Y,RMPFMENU=0 D ^RMPFDT10 Q
 | 
|---|
 | 46 |  Q
 | 
|---|
 | 47 | QUE W ! S %ZIS="NPQ" D ^%ZIS G END:POP
 | 
|---|
 | 48 |  I IO=IO(0),'$D(IO("S")) D ^RMPFDT9 G QUEE
 | 
|---|
 | 49 |  I $D(IO("S")) S %ZIS="",IOP=ION D ^%ZIS G ^RMPFDT9
 | 
|---|
 | 50 |  S ZTRTN="^RMPFDT9",ZTSAVE("RMPF*")=""
 | 
|---|
 | 51 |  S ZTIO=ION D ^%ZTLOAD
 | 
|---|
 | 52 |  D HOME^%ZIS S RMPFOUT=""
 | 
|---|
 | 53 |  W:$D(ZTSK) !!,"*** Request Queued ***" H 1
 | 
|---|
 | 54 | QUEE K %T,%ZIS,POP,ZTRTN,ZTSAVE,ZTIO,ZTSK Q
 | 
|---|
 | 55 | READ K RMPFOUT,RMPFQUT
 | 
|---|
 | 56 |  R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
 | 
|---|
 | 57 |  I Y?1"^".E S (RMPFOUT,Y)="" Q
 | 
|---|
 | 58 |  S:Y?1"?".E (RMPFQUT,Y)=""
 | 
|---|
 | 59 |  Q
 | 
|---|