112 lines
5.8 KiB
Mathematica
112 lines
5.8 KiB
Mathematica
ORLPR0 ; SLC/CLA - Report formatter for patient lists ;11/27/91 [3/22/00 12:41pm]
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**47**;Dec 17, 1997
|
|
;
|
|
OUTPUT ;called by TaskMan via ORUTL1 (ORUTL1 queued output was setup by INQ)
|
|
; SLC/PKS - Modified 8/99.
|
|
U IO
|
|
N ORTDATA,ORTDEV,ORTCREAT,ORTSUB,ORTTYPE
|
|
S (PR,PF,PAGE)=1,ORLOUT="",ORTIT=$S(TL="TA":"Team Patient Autolinked List",TL="TM":"Team Patient Manual List",TL="MRAL":"Team Patient Manual Removal/Autolinked List",1:"Personal Patient List"),ORTIT(1)=$P(ORLIST,U,2)
|
|
S:$E(IOST,1,2)'="C-" ORSNUM=1 D HEADING K ORSNUM
|
|
S ORTDATA=^OR(100.21,+ORLIST,0) ; Get 0-node data.
|
|
S ORTDEV=$P(ORTDATA,U,4) ; Assign "device."
|
|
I ORTDEV'="" D ; "Device" exist?
|
|
. S ORTDEV=$$GET1^DIQ(3.5,+($G(ORTDEV)),.01) ; Get device name.
|
|
S ORTCREAT=$P(ORTDATA,U,5) ; Assign "creator."
|
|
I ORTCREAT'="" D ; "Creator" exist?
|
|
. S ORTCREAT=$P($G(^VA(200,ORTCREAT,0)),U) ; Get creator's name.
|
|
S ORTTYPE=$P(ORTDATA,U,2) ; Assign type.
|
|
I ORTTYPE'="" D TYPESTR ; Full type string.
|
|
S ORTSUB="" ; Initialize.
|
|
I TL["A" D ; A/L type?
|
|
. S ORTSUB=$P(ORTDATA,U,6) ; Assign "subcribe."
|
|
. I ORTSUB="" S ORTSUB="NO" ; Default for no data.
|
|
. I ORTSUB="Y" S ORTSUB="YES" ; Full word.
|
|
; Put in a blank line if no device, creator, type, or subscribe info:
|
|
I (ORTDEV'="")!(ORTCREAT'="")!(ORTTYPE'="")!(ORTSUB'="") W !
|
|
I ORTCREAT'="" W !," Creator: "_ORTCREAT ; Write creator line.
|
|
I ORTDEV'="" W !," Device: "_ORTDEV ; Write device line.
|
|
I ORTTYPE'="" W !," Type: "_ORTTYPE ; Write type line.
|
|
I TL["A" W !," Subscribable: "_ORTSUB ; Subscribe line.
|
|
S ORI=0 F S ORI=$O(^OR(100.21,+ORLIST,1,ORI)) Q:ORI<1 S USER=^(ORI,0) D
|
|
. S ^TMP("ORLP",$J,"LIST","B",$P(^VA(200,+USER,0),"^"))=""
|
|
D USER
|
|
I TL["A",$O(^OR(100.21,+ORLIST,2,0)) S PR=1 D D ALINK
|
|
. N VP,OROK
|
|
. S ORI=0 F S ORI=$O(^OR(100.21,+ORLIST,2,ORI)) Q:'ORI D
|
|
.. S VP=^(ORI,0),VP(1)="^"_$P($P(VP,";",2),U),VP(2)=+VP I $L(VP,"^")=2 S VP(3)=$S($P(VP,U,2)="A":"Attending",$P(VP,U,2)="P":"Primary",1:"Primary or Attending")
|
|
.. S OROK=0
|
|
.. I VP(1)["DIC(42," S OROK=1,VPNM="Ward......."_$P(@(VP(1)_VP(2)_",0)"),U)
|
|
.. I VP(1)["VA(200," S OROK=1,VPNM="Provider..."_$P(@(VP(1)_VP(2)_",0)"),U)_" - as "_VP(3)
|
|
.. I VP(1)["DIC(45.7," S OROK=1,VPNM="Specialty.."_$P(@(VP(1)_VP(2)_",0)"),U)
|
|
.. I VP(1)["DG(405.4," S OROK=1,VPNM="Room/Bed..."_$P(@(VP(1)_VP(2)_",0)"),U)
|
|
.. I VP(1)["SC" S OROK=1,VPNM="Clinic....."_$P(@(VP(1)_VP(2)_",0)"),U)
|
|
.. I 'OROK S VPNM="(Undetermined) - "_$P(@(VP(1)_VP(2)_",0)"),U)
|
|
.. S ^TMP("ORLP",$J,"LIST","AL",VPNM)=""
|
|
S ORI=0 F S ORI=$O(^OR(100.21,+ORLIST,10,ORI)) Q:ORI<1 D
|
|
. N VAERR,VAIN,DFN
|
|
. S PAT=^OR(100.21,+ORLIST,10,ORI,0),DFN=+PAT,PAT=^DPT(DFN,0)
|
|
. D INP^VADPT Q:VAERR S WRD=$S(VAIN(4):$E($P(VAIN(4),U,2),1,10),1:"WD-none"),RMBED=$S(VAIN(5)]"":VAIN(5),1:"unassigned"),SSN=$E($P(PAT,U,9),6,9)_"0000",PATNM=$P(PAT,U)
|
|
. I SORT="T" S ^TMP("ORLP",$J,"LIST","C","A"_$E(SSN,1,4),PATNM,WRD_": "_RMBED)="" Q
|
|
. I SORT="R" S ^TMP("ORLP",$J,"LIST","C",WRD_": "_RMBED,PATNM,$E(SSN,1,4))="" Q
|
|
. S ^TMP("ORLP",$J,"LIST","C",$P(PAT,"^"),$E(SSN,1,4),WRD_": "_RMBED)=""
|
|
D PT
|
|
I ORLOUT'["^" W !!?5,"List completed." D
|
|
. I $E(IOST)="C" S DIR(0)="E" D ^DIR
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
END ;called by INQ, flow thru from OUTPUT
|
|
K ALINK,DIR,L,LINE,ORI,ORLOUT,ORTIT,PAGE,PAT,PATNM,PF,PR,PT,PTRB,PTSSN,RMBED,SSN,USER,VPNM,WRD,X1,X2,X3,Y,%ZIS,ZTDESC,ZTRTN,ZTSAVE
|
|
K ^TMP("ORLP",$J,"LIST")
|
|
Q
|
|
;
|
|
HEADING ;called by OUTPUT, USER, PT - build list heading & handle paging
|
|
Q:ORLOUT["^"
|
|
I $$S^%ZTLOAD S ORLOUT="^",ZTSTOP=1 Q
|
|
I PAGE>1,($E(IOST)="C") S DIR(0)="E" D ^DIR I Y<1 S ORLOUT="^" Q
|
|
W:'$D(ORSNUM) @IOF
|
|
W !,$P($$HTE^XLFDT($H),"@"),?(IOM-$L(ORTIT)/2),ORTIT,?70,"page ",PAGE
|
|
W !?(IOM-$L(ORTIT(1))/2),ORTIT(1) W !?(IOM-$L(ORTIT(1))/2)-2 F L=0:1 W "=" Q:L=($L(ORTIT(1))+4)
|
|
S (PR,PF)=1,PAGE=PAGE+1
|
|
Q
|
|
ALINK ;called by OUTPUT - build entries (autolinks)
|
|
S ALINK="" F S ALINK=$O(^TMP("ORLP",$J,"LIST","AL",ALINK)) Q:ALINK="" D
|
|
. I $L(ALINK)'<1,($Y+2>IOSL) D HEADING Q:ORLOUT["^"
|
|
. I PR=1 W !!," Autolinks: ",ALINK S PR=2
|
|
. E W !?16,ALINK
|
|
Q
|
|
USER ;called by OUTPUT - build list entries (users)
|
|
S USER="" F S USER=$O(^TMP("ORLP",$J,"LIST","B",USER)) Q:USER="" D
|
|
. I $L(USER)'<1,($Y+2>IOSL) D HEADING Q:ORLOUT["^"
|
|
. I PR=1 W !!,"Provider/users: ",USER S PR=2
|
|
. E W !?16,USER
|
|
Q
|
|
PT ;called by OUTPUT - build list entries (patients)
|
|
N DOTS,SPACE,WRDL
|
|
S $P(DOTS,".",34)="",$P(SPACE," ",28)="",WRDL=""
|
|
S X1="" F S X1=$O(^TMP("ORLP",$J,"LIST","C",X1)) Q:X1="" D
|
|
. S X2="" F S X2=$O(^TMP("ORLP",$J,"LIST","C",X1,X2)) Q:X2="" D
|
|
.. S X3="" F S X3=$O(^TMP("ORLP",$J,"LIST","C",X1,X2,X3)) Q:X3="" D
|
|
... ; sort="T" Terminal digit sort
|
|
... I SORT="T" S LINE="("_$E(X1,2,5)_") "_$E(X2_DOTS,1,33)_" "_$E(X3_SPACE,1,27) D PT1 Q
|
|
... ; sort="R" Room/Bed sort
|
|
... I SORT="R" D D PT1 Q
|
|
.... I PF=1 S LINE=$E(X1_SPACE,1,27)_" "_$E(X2_DOTS,1,33)_" ("_X3_")" Q
|
|
.... I WRDL'=$P(X1,":") S LINE=$E(X1_SPACE,1,27)_" "_$E(X2_DOTS,1,33)_" ("_X3_")" Q
|
|
.... S LINE=$E($E(SPACE,1,$L(WRDL)+1)_$P(X1,":",2)_SPACE,1,27)_" "_$E(X2_DOTS,1,33)_" ("_X3_")"
|
|
... ; else sort alpha by patient name
|
|
... S LINE=$E(X1_DOTS,1,33)_"("_X2_") "_X3 D PT1
|
|
Q
|
|
;
|
|
PT1 I $L(X1)'<1,($Y+3>IOSL) D HEADING Q:ORLOUT["^"
|
|
I SORT="R" S WRDL=$P(X1,":") I PF=1 S LINE=$E(X1_SPACE,1,27)_" "_$E(X2_DOTS,1,33)_" ("_X3_")"
|
|
I PF=1 W !!,"Patients: " S PF=2
|
|
W !?3,LINE
|
|
Q
|
|
TYPESTR ; Assign description strings to ORTTYPE (Team List type) variables.
|
|
; Tag by PKS - 8/99.
|
|
;
|
|
I ORTTYPE="P" S ORTTYPE="PERSONAL"
|
|
I ORTTYPE="TA" S ORTTYPE="AUTOLINK"
|
|
I ORTTYPE="TM" S ORTTYPE="MANUAL"
|
|
I ORTTYPE="MRAL" S ORTTYPE="MRAL"
|
|
Q
|