87 lines
4.6 KiB
Mathematica
87 lines
4.6 KiB
Mathematica
RMPFDS1 ;DDC/KAW-LIST ORDERS BY PATIENT OR STATUS; [ 03/12/98 7:45 AM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8,10,16**;MAY 30, 1995
|
|
;;Reference to ^VA(200) supported by DBIA #10060
|
|
;; input: RMPFTP,RMPFORD,DFN (if RMPFORD="P")
|
|
;;output: RMPFS,RMPFCX,RMPFO
|
|
I $D(DFN),DFN D PAT^RMPFUTL
|
|
D @("HEAD"_RMPFORD) S (RMPF,RMPFCX)=0
|
|
I RMPFORD="S" F I=1:1 S RMPF=$O(^RMPF(791810,"AD",RMPF)) Q:'RMPF G END:$D(RMPFOUT) S RMPFX=0 F J=1:1 S RMPFX=$O(^RMPF(791810,"AD",RMPF,RMPFX)) Q:'RMPFX D SUB G END:$D(RMPFOUT),END:'$D(RMPFX)
|
|
I RMPFORD="P" F I=1:1 S RMPF=$O(^RMPF(791810,"AE",DFN,RMPF)) Q:RMPF="" G END:$D(RMPFOUT) S RMPFX=0 F J=1:1 S RMPFX=$O(^RMPF(791810,"AE",DFN,RMPF,RMPFX)) Q:'RMPFX D SUB G END:$D(RMPFOUT),END:'$D(RMPFX)
|
|
G END:$D(RMPFOUT)
|
|
W:RMPFCX<1 !!,"NO EXISTING ORDERS"
|
|
W:RMPFCX !!,"Total Orders: ",RMPFCX
|
|
W:IOST?1"P-".E @IOF
|
|
D:$D(IO("S")) ^%ZISC
|
|
END K RMPFNAM,SSN,RMPFSSN,RMPFDOB,DOB,Y,RMPF,RMPFX,RMPFST,RMPFMGG,RMPFSD
|
|
K I,J,T,RMPFDOD,OO Q
|
|
READ K RMPFOUT,RMPFQUT
|
|
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|
I Y?1"^" S (RMPFOUT,Y)="" Q
|
|
S:Y?1"?".E (RMPFQUT,Y)=""
|
|
Q
|
|
SUB ;;input: RMPFX,RMPFTP,RMPFORD,RMPFCX,RMPFNAM,RMPFSSN,RMPFDOB,RMPFP (opt), RMPFOO (opt.)
|
|
;;output: RMPFCX,RMPFS
|
|
Q:RMPFX=""
|
|
Q:'$D(^RMPF(791810,RMPFX,0)) S SX=^(0)
|
|
S X=$P(SX,U,15) S:X="" X=1 S X=$P(^RMPF(791810.5,X,0),U,2) S:X="" X=1 Q:X'=RMPFMENU
|
|
Q:'$D(^RMPF(791810,RMPFX,"STA")) Q:$P(RMPFSTAP," - ",1)'=$P($P(^("STA"),U,1)," - ",1)
|
|
I $D(RMPFOO) D I OO,OO'=RMPFOO Q
|
|
.S OO=$P(SX,U,8),X=0 D ARRAY^RMPFDT2
|
|
.F S X=$O(RMPFO(X)) Q:'X I $D(^RMPF(791810,RMPFX,101,X,90)),$P(^(90),U,12) S OO=$P(^(90),U,12)
|
|
S Y=$P($P(SX,U,1),".",1),RMPFTDP=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
|
|
S Y=$P($P(SX,U,6),".",1),RMPFSD=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_($E(Y,1,3)+1700)
|
|
S RMPFTYP="",X=$P(SX,U,2)
|
|
G SUBE:'X,SUBE:'$D(^RMPF(791810.1,X,0)) S SS=^(0)
|
|
S RMPFTYP=$S(RMPFTP'="S":$P(SS,U,8),1:$P(SS,U,1)),T=$P(SS,U,3)
|
|
I RMPFTP'="B" G SUBE:T'=RMPFTP
|
|
G SUBE:RMPFTYP=""
|
|
S RMPFST="",X=$P(SX,U,3) I X,$D(^RMPF(791810.2,X,0)) S RMPFST=$P(^(0),U,4)
|
|
G SUBE:X="" I RMPFORD="S",$D(RMPFP)'=1 G SUBE:'$D(RMPFP(X))
|
|
I RMPFORD="P",$D(RMPFP)=10 G SUBE:'$D(RMPFP(X))
|
|
I RMPFORD="S" S RMPFNAM="N/A",RMPFSSN="",DFN=$P(SX,U,4) I RMPFTP'="S",DFN D PAT^RMPFUTL
|
|
S RMPFAD=$P(SX,U,8),RMPFADP="" I RMPFAD,$D(^VA(200,RMPFAD,0)) S RMPFADP=$P(^(0),U,1)
|
|
I RMPFMENU=0 D ARRAY^RMPFDT2 S X=0 F S X=$O(RMPFO(X)) Q:'X I $D(^RMPF(791810,RMPFX,101,X,90)),$P(^(90),U,12) S Y=$P(^(90),U,12) I Y,$D(^VA(200,Y,0)) S RMPFADP=$P(^(0),U,1)
|
|
S CT=0,RMPFCX=RMPFCX+1,RMPFS(RMPFCX)=RMPFX
|
|
I IOST?1"C-".E,$Y>20 D CONT S:'$D(RMPFX) RMPFOUT="" G SUBE:$D(RMPFOUT) D @("HEAD"_RMPFORD)
|
|
I IOST?1"P-".E,$Y>(IOSL-5) D @("HEAD"_RMPFORD)
|
|
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
|
|
D @("WRITE"_RMPFORD)
|
|
SUBE K S0,SS,SX,Y,RMPFTDP,RMPFTYP,X,TT,RMPFAD,RMPFADP,CT,RMPFMGG
|
|
K RMPFO,RMPFSD,RMPFST,T Q
|
|
HEADP W @IOF,!?24,"REMOTE ORDER/ENTRY PATIENT ORDERS"
|
|
W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|
W !,"Patient: ",$E(RMPFNAM,1,25),?40,"SSN: ",RMPFSSN,?62,"DOB: ",RMPFDOB
|
|
W !!?6,"Status",?46,"Order"
|
|
W !?1,"#",?7,"Date",?15,"Status",?23,"Type",?30,"Ord" W $S(RMPFMENU=0:"/Iss",1:"ered") W " By",?46,"Date",?54,"MSG",?65,"Item(s)"
|
|
W !,"---",?4,"----------",?15,"------",?22,"------",?29,"-------------",?43,"----------",?54,"---",?58,"----------------------"
|
|
Q
|
|
WRITEP W !,$J(RMPFCX,2),". ",RMPFSD,?15,RMPFST,?22,RMPFTYP,?29,$E(RMPFADP,1,13),?43,RMPFTDP,?54,RMPFMGG D ARRAY^RMPFDT2 S X=0
|
|
W1 S X=$O(RMPFO(X)) G W2:'X
|
|
I $D(^RMPF(791810,RMPFX,101,X,0)) S RMPFIT=$P(^(0),U,1) D
|
|
.Q:'RMPFIT Q:'$D(^RMPF(791811,RMPFIT,0)) S S0=^(0)
|
|
.I RMPFIT=1 S RMPFITP=$P($G(^RMPF(791810,RMPFX,101,X,2)),U,2)
|
|
.E S RMPFITP=$E($P(S0,U,1),1,22)
|
|
.W:CT ! W ?58,RMPFITP S CT=CT+1
|
|
G W1
|
|
W2 K RMPFIT,RMPFITP Q
|
|
HEADS W @IOF,!?28,"REMOTE ORDER/ENTRY ORDERS"
|
|
HEADS1 W !,"Station: ",RMPFSTAP,?68,RMPFDAT
|
|
W !!?5,"Status",?68,"Order"
|
|
W !,?1,"#",?6,"Date",?15,"Status" W:RMPFTP="S" ?35,"Type"
|
|
W:RMPFTP'="S" ?23,"Type",?36,"Patient" W ?53,"Ord" W $S(RMPFMENU=0:"/Iss",1:"ered") W " By",?69,"Date",?77,"MSG"
|
|
W !,"---",?4,"----------",?15,"------"
|
|
I RMPFTP'="S" W ?22,"------",?29,"----------------------"
|
|
E W ?22,"------------------------------"
|
|
W ?53,"-----------",?66,"----------",?77,"---"
|
|
Q
|
|
WRITES W !,$J(RMPFCX,2),". ",RMPFSD,?15,RMPFST
|
|
W ?22,$E(RMPFTYP,1,$S(RMPFTP'="S":14,1:28))
|
|
W:RMPFTP'="S" ?29,$E(RMPFNAM,1,16) W:RMPFSSN'="" ?46,"-",$E(RMPFSSN,8,11)
|
|
W ?53,$E(RMPFADP,1,11),?66,RMPFTDP,?77,RMPFMGG
|
|
Q
|
|
CONT F I=1:1 Q:$Y>20 W !
|
|
W !,"Type <RETURN> to continue, <P>rint or <^> to exit: " D READ
|
|
Q:$D(RMPFOUT) G CONT:$D(RMPFQUT)
|
|
Q:Y="" D QUE^RMPFDS2:"Pp"[Y
|
|
Q
|