| 1 | RMPFDT1 ;DDC/KAW-PATIENT ORDER INFORMATION; [ 06/16/95 3:06 PM ]
|
|---|
| 2 | ;;2.0;REMOTE ORDER/ENTRY SYSTEM;;JUN 16, 1995
|
|---|
| 3 | ;;input: RMPFX,RMPFTE (for patient types)
|
|---|
| 4 | ;;output: RMPFTYP,RMPFST,RMPFHAT,RMPFTP
|
|---|
| 5 | I $D(RMPFX),RMPFX,$D(^RMPF(791810,RMPFX,0))
|
|---|
| 6 | E Q
|
|---|
| 7 | S (RMPFNAM,RMPFDOB,RMPFSSN)="",S0=^RMPF(791810,RMPFX,0)
|
|---|
| 8 | S DFN=$P(S0,U,4) I DFN D PAT^RMPFUTL
|
|---|
| 9 | S RMPFTYP=$P(S0,U,2),RMPFST=$P(S0,U,3)
|
|---|
| 10 | I RMPFTYP,$D(^RMPF(791810.1,RMPFTYP,0)) S RMPFHAT=$P(^(0),U,2),RMPFTP=$P(^(0),U,3)
|
|---|
| 11 | D ^RMPFDT5 G END:$D(RMPFOUT)
|
|---|
| 12 | G END:"PS"'[RMPFTP D @("HEAD"_RMPFTP),DISP
|
|---|
| 13 | END K RMPFNAM,RMPFSSN,RMPFDOB,RMPFDOD,RMPFY,RMPFOD,RMPFMSG,CN Q
|
|---|
| 14 | DISP S CN=1
|
|---|
| 15 | S RMPFMGG="",X=0 F I=1:1 S X=$O(^RMPF(791810,RMPFX,201,X)) Q:'X S Y=0 F J=1:1 S Y=$O(^RMPF(791810,RMPFX,201,X,101,Y)) Q:'Y I $D(^(Y,0)),'$P(^(0),U,6) S RMPFMGG="***" Q
|
|---|
| 16 | W ! I $D(RMPFMGG),RMPFMGG'="" W ?29,"*** UNREAD MESSAGE ***"
|
|---|
| 17 | F I=1:1 S X=$P($T(PROMPT+I),";;",2) Q:X="" D
|
|---|
| 18 | .X X
|
|---|
| 19 | .Q:'$D(^RMPF(791810.1,RMPFTYP,100,CN,0)) S Y=$P(^(0),U,4),Z=$P(^(0),U,5)
|
|---|
| 20 | .Q:Y=""!(Z="")!(Z="RMPFRMK") I $D(RMPFEDIT) W:$X>47 ! W ?43,"[",CN,"]"
|
|---|
| 21 | .W:$X>47 ! W ?47,$J(Y,12),": ",$E(@Z,1,19) S CN=CN+1
|
|---|
| 22 | S CR=CN-1 F L=1:1 S CR=$O(^RMPF(791810.1,RMPFTYP,100,CR)) Q:'CR D
|
|---|
| 23 | .I $P(^RMPF(791810.1,RMPFTYP,100,CR,0),U,2)["RMPFMOD" W ! D ^RMPFDT2 Q
|
|---|
| 24 | .S Y=$P(^RMPF(791810.1,RMPFTYP,100,CR,0),U,4),Z=$P(^(0),U,5)
|
|---|
| 25 | .Q:Y=""!(Z="") W !
|
|---|
| 26 | .I $D(RMPFEDIT) W:$X>47 ! W:Z'="RMPFRMK" ?43 W "[",CN,"]"
|
|---|
| 27 | .W:$X>47 ! W:Z'="RMPFRMK" ?47 W:Z="RMPFRMK" ?2 W $J(Y,$S(Z'="RMPFRMK":12,1:8)),": ",$E(@Z,1,$S(Z'="RMPFRMK":19,1:70)) S CN=CN+1
|
|---|
| 28 | CON W:$D(RMPFTA) !?27,"*** ROES Address ***"
|
|---|
| 29 | I $D(RMPFERR) W !!,"Missing Required Information:" D
|
|---|
| 30 | .S X=0 F I=1:1 S X=$O(RMPFERR(X)) Q:X="" W $C(7),!,"*** ",X," ***" I $Y>18,$O(RMPFERR(X))!$D(RMPFMSG) D CONT^RMPFDT2 Q:$D(RMPFOUT) W @IOF
|
|---|
| 31 | I $D(RMPFMSG) W !!,"Message:" D
|
|---|
| 32 | .S X=0 F I=1:1 S X=$O(RMPFMSG(X)) Q:X="" W $C(7),!,X I $Y>19,$O(RMPFMSG(X)) D CONT^RMPFDT2 Q:$D(RMPFOUT) W @IOF
|
|---|
| 33 | S X=$P(^RMPF(791810.1,RMPFTYP,0),U,5) I $L(X) D CONT^RMPFDT2:$Y>19 S X="*** "_X_" ***" W $C(7),!!,?80-$L(X)\2,X
|
|---|
| 34 | W:IOST?1"P-".E @IOF
|
|---|
| 35 | D:$D(IO("S")) ^%ZISC
|
|---|
| 36 | DISPE K RMPFADP,RMPFAPD,RMPFAPP,RMPFDC,RMPFDR,RMPFODP,RMPFDDC,RMPFDIS
|
|---|
| 37 | K RMPFRMK,RMPFSTP,RMPFTF,RMPFURP,RMPFUS,RMPFCAT,RMPFCERD,RMPFCERU
|
|---|
| 38 | K RMPFTDP,RMPFCUR,RMPFINV,RMPFMD,RMPFPO,RMPFRDC,RMPFDSN
|
|---|
| 39 | K RMPFTA,RMPFTYPP,RMPFLIS,RMPFMGG,RMPFO,RMPFPCT,RMPFPG,RMPFPSC,RMPFTT
|
|---|
| 40 | K RMPFAD,S4,X,Y,L,CX,CR,Z Q
|
|---|
| 41 | HEADP W @IOF,!?22,"REMOTE ORDER/ENTRY ORDER INFORMATION"
|
|---|
| 42 | HEADP1 W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|---|
| 43 | W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
|
|---|
| 44 | W ! F I=1:1:80 W "-"
|
|---|
| 45 | Q
|
|---|
| 46 | HEADS W @IOF,!!?18,"REMOTE ORDER/ENTRY STATION ORDER INFORMATION"
|
|---|
| 47 | W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|---|
| 48 | W ! F I=1:1:80 W "-"
|
|---|
| 49 | Q
|
|---|
| 50 | PROMPT ;;
|
|---|
| 51 | ;;W !?1,"Order Date/Time: ",RMPFTDP
|
|---|
| 52 | ;;W !?6,"Order Type: ",$E(RMPFTYPP,1,23)
|
|---|
| 53 | ;;W !?10,"Status: ",$E(RMPFSTP,1,23)
|
|---|
| 54 | ;;W !?6,"Entered By: ",$E(RMPFURP,1,23)
|
|---|
| 55 | ;;W:RMPFTP="P" !?5,"Eligibility: ",$E($P(RMPFTE,U,1),1,23)
|
|---|
| 56 | ;;W:RMPFAPP'="" !?2,$S(RMPFST'=7:" Approved ",1:"Disapproved "),"By: ",$E(RMPFAPP,1,23)
|
|---|
| 57 | ;;I RMPFAPD'="" W:RMPFST=7 !,"Disapproval Date: " W:RMPFST'=7 !?3,"Approval Date: " W RMPFAPD
|
|---|
| 58 | ;;W:RMPFDR'="" !,$S(RMPFST'=7:"Approval ",1:"Disapprov "),"Reason: ",$E(RMPFDR,1,23)
|
|---|
