source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFDS1.m@ 1607

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