ORKUTL ; slc/CLA - Utility routine for order checking ;5/21/97 16:25
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6**;Dec 17, 1997
ONOFF(ORK,ORKUSR,ORKPT) ;Extrinsic function to check param file determines if
; user ORKUSR should receive order check ORK for patient ORKPT.
;ORK order check ien from file 864.5 (req'd)
;ORKUSR user ien from file 200 (req'd)
;ORKPT patient ien from file 2 (not req'd)
;
N NODE,ORKNAME,ORKUSRN,ORKUSRF,ORKPTN,ORKLOC,ORKLOCN,ORKLOCF
N ORKSRV,ORKSRVN,ORKSRVF,ORKDIVF,ORKSYSF,ORKPKGF
;
;get order check name:
S NODE=$G(^ORD(100.8,ORK,0)) S:$L($G(NODE)) ORKNAME=$P(NODE,U)
;
;get user name:
S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) ORKUSRN=$P(NODE,U)
;
;get patient name:
S:$L($G(ORKPT)) NODE=$G(^DPT(ORKPT,0)) S:$L($G(NODE)) ORKPTN=$P(NODE,U)
;
;get patient's location (INPATIENT ONLY - outpt locations cannot be
;reliably determined, and many simultaneous outpt locations can occur):
I +$G(ORKPT)>0 D
.N DFN S DFN=ORKPT,VA200="" D OERR^VADPT
.S ORKLOC=+$G(^DIC(42,+VAIN(4),44)) I +$G(ORKLOC)>0 D
..S ORKLOCN=$P(^SC(+ORKLOC,0),U)
K VA200,VAIN
;
;get user's service/section:
S ORKSRV=$G(^VA(200,ORKUSR,5)) I +ORKSRV>0 S ORKSRV=$P(ORKSRV,U) D
.S NODE=$G(^DIC(49,ORKSRV,0)) S:$L($G(NODE)) ORKSRVN=$P(NODE,U)
;
S ORK="`"_ORK
;
;get user's flag:
S ORKUSRF=$$GET^XPAR("USR.`"_+$G(ORKUSR),"ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKUSRF)) $S($P(ORKUSRF,U)="D":"OFF",1:"ON")_"^User value is "_$P(ORKUSRF,U,2)
;
;get patient location flag:
I +$G(ORKLOC)>0 D
.S ORKLOCF=$$GET^XPAR("LOC.`"_+$G(ORKLOC),"ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKLOCF)) $S($P(ORKLOCF,U)="D":"OFF",1:"ON")_"^Pt's location "_ORKLOCN_" value is "_$P(ORKLOCF,U,2)
;
;get user's service flag:
I +$G(ORKSRV)>0 D
.S ORKSRVF=$$GET^XPAR("SRV.`"_+$G(ORKSRV),"ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKSRVF)) $S($P(ORKSRVF,U)="D":"OFF",1:"ON")_"^User's service "_ORKSRVN_" value is "_$P(ORKSRVF,U,2)
;
;get user's division flag:
S ORKDIVF=$$GET^XPAR("DIV","ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKDIVF)) $S($P(ORKDIVF,U)="D":"OFF",1:"ON")_"^Division value is "_$P(ORKDIVF,U,2)
;
;get system flag:
S ORKSYSF=$$GET^XPAR("SYS","ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKSYSF)) $S($P(ORKSYSF,U)="D":"OFF",1:"ON")_"^System value is "_$P(ORKSYSF,U,2)
;
;get OE/RR package-exported flag:
S ORKPKGF=$$GET^XPAR("PKG","ORK PROCESSING FLAG",ORK,"B")
Q:$L($G(ORKPKGF)) $S($P(ORKPKGF,U)="D":"OFF",1:"ON")_"^OERR value is "_$P(ORKPKGF,U,2)
;
Q "ON^No value found"
USRCHKS(ORKUSR) ; generate a list of order checks indicating user's recip status
I +$G(ORKUSR)<1 S ORKUSR=DUZ
N ORY,ORYI,ORKY,ORKIEN,ORKNAM,NODE,ORX,DESC,HDR
S ORYI=1
;
;prompt for additional information:
W !!,"Would you like help understanding the list of order checks" S %=2 D YN^DICN I %=1 D HLPMSG
K %
;
;see if order checking system is disabled:
S ORX=$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")
I ORX="D" D
.S ORY(ORYI)="Order Checking is disabled. No order checks will be processed or displayed."
.S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) HDR="Order Check List for "_$P(NODE,U)
.S DESC="Order check possibilities for a user"
.D OUTPUT(.ORY,DESC,HDR)
Q:ORX="D"
;
W !!,"This will take a moment or two, please stand by."
;
S ORY(ORYI)="Order Check ON/OFF For This User and Why",ORYI=ORYI+1
S ORY(ORYI)="-------------------------------- ---------------------------------------------",ORYI=ORYI+1
;
;loop thru all order checks and determine recipient status:
S ORKNAM="" F S ORKNAM=$O(^ORD(100.8,"B",ORKNAM)) Q:ORKNAM="" D
.S ORKIEN=0,ORKIEN=$O(^ORD(100.8,"B",ORKNAM,ORKIEN)) I +$G(ORKIEN)>0 D
..S ORKY(ORKNAM)=ORKIEN
..S ORX=$$ONOFF(ORKIEN,ORKUSR,"") I $L($G(ORX)) D
...W "."
...S ORKNAM=$E(ORKNAM_" ",1,32)
...S ORY(ORYI)=ORKNAM_" "_$E($P(ORX,U)_" ",1,5)_$P(ORX,U,2),ORYI=ORYI+1
;
S ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1
S DESC="Order check possibilities for a user"
S NODE=$G(^VA(200,ORKUSR,0)) S:$L($G(NODE)) HDR="Order Check List for "_$P(NODE,U)
D OUTPUT(.ORY,DESC,HDR)
Q
HLPMSG ;display/print help message for a user's order checks
N ORY,ORYI
S ORYI=1
S ORY(ORYI)="The delivery of order checks is determined from values set for Users,",ORYI=ORYI+1
S ORY(ORYI)="Inpatient Locations, Service/Sections, Hospital Divisions, Computer System and",ORYI=ORYI+1
S ORY(ORYI)="OERR. Possible values include 'Enabled' and 'Disabled'. These values indicate",ORYI=ORYI+1
S ORY(ORYI)="a User's, Location's, Service/Section's, Division's, System's and OERR's",ORYI=ORYI+1
S ORY(ORYI)="desire for the order check to be 'Enabled' (displayed under most",ORYI=ORYI+1
S ORY(ORYI)="circumstances) or 'Disabled' (normally not displayed.)",ORYI=ORYI+1
S ORY(ORYI)="",ORYI=ORYI+1
S ORY(ORYI)="All values, except the OERR (Order Entry) value, can be set by IRM",ORYI=ORYI+1
S ORY(ORYI)="or Clinical Coordinators. Individual users can set their 'Enabled/Disabled'",ORYI=ORYI+1
S ORY(ORYI)="values for each specific order check via the 'Enable/Disable My Order Checks'",ORYI=ORYI+1
S ORY(ORYI)="option under the Personal Preferences and Order Check Management for Users.",ORYI=ORYI+1
S ORY(ORYI)="'ON' indicates the user will receive the order check under normal conditions.",ORYI=ORYI+1
S ORY(ORYI)="'OFF' indicates the user normally will not receive the order check.",ORYI=ORYI+1
S ORY(ORYI)="Order check recipient determination can also be influenced by patient",ORYI=ORYI+1
S ORY(ORYI)="location (inpatients only.) This list does not consider patient location",ORYI=ORYI+1
S ORY(ORYI)="when calculating the ON/OFF value for an order check because a patient is",ORYI=ORYI+1
S ORY(ORYI)="not known when the option is selected.",ORYI=ORYI+1
S ORY(ORYI)="",ORYI=ORYI+1,ORY(ORYI)="",ORYI=ORYI+1
S DESC="Help Message - order check possibilities for a user"
S HDR="Order Check List Help Message"
D OUTPUT(.ORY,DESC,HDR)
Q
OUTPUT(ORY,ORKDESC,ORKHDR) ;prompt for device and send report
N POP,ORBHDR
N ZTRTN,ZTSAVE,ZTDESC
;prompt for device:
S %ZIS="Q" ;prompt for Queueing
D ^%ZIS
Q:$G(POP)>0
I $D(IO("Q")) D ;queue the report
.S ZTRTN="PRINT^ORB3U1"
.S ORBHDR=ORKHDR
.S ZTSAVE("ORY(")="",ZTSAVE("ORBHDR")=""
.S ZTDESC=ORKDESC
.D ^%ZTLOAD
.I $D(ZTSK)[0 W !!?5,"Report canceled!"
.E W !!?5,"Report queued."
.D HOME^%ZIS
K %ZIS
I $D(IO("Q")) K IO("Q") Q
PRINT ;print body of List User's Order checks Report
N END,PAGE,I,X
S (END,PAGE,I)=0
U IO
D @("HDR"_(2-($E(IOST,1,2)="C-")))
F S I=$O(ORY(I)) Q:I=""!(END=1) D
.D HDR:$Y+5>IOSL
.Q:END=1
.W !,ORY(I)
I END=1 W !!," - Report Interrupted -",!
E W " - End of Report -",!
I ($E(IOST,1,2)="C-") W !,"Press RETURN to continue: " R X:DTIME
D ^%ZISC
D:$G(ZTSK) KILL^%ZTLOAD
Q
HDR ;print header of report
I PAGE,($E(IOST,1,2)="C-") D
.W !,"Press RETURN to continue or '^' to exit: "
.R X:DTIME S END='$T!(X="^")
Q:END=1
HDR1 W:'($E(IOST,1,2)='"C-"&'PAGE) @IOF
HDR2 S PAGE=PAGE+1 W ?20,ORKHDR
W ?(IOM-10),"Page: ",$J(PAGE,3),!!
Q
ORKUTL ; slc/CLA - Utility routine for order checking ;5/21/97 16:25
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6**;Dec 17, 1997
ONOFF(ORK,ORKUSR,ORKPT) ;Extrinsic function to check param file determines if
+1 ; user ORKUSR should receive order check ORK for patient ORKPT.
+2 ;ORK order check ien from file 864.5 (req'd)
+3 ;ORKUSR user ien from file 200 (req'd)
+4 ;ORKPT patient ien from file 2 (not req'd)
+5 ;
+6 NEW NODE,ORKNAME,ORKUSRN,ORKUSRF,ORKPTN,ORKLOC,ORKLOCN,ORKLOCF
+7 NEW ORKSRV,ORKSRVN,ORKSRVF,ORKDIVF,ORKSYSF,ORKPKGF
+8 ;
+9 ;get order check name:
+10 SET NODE=$GET(^ORD(100.8,ORK,0))
IF $LENGTH($GET(NODE))
SET ORKNAME=$PIECE(NODE,U)
+11 ;
+12 ;get user name:
+13 SET NODE=$GET(^VA(200,ORKUSR,0))
IF $LENGTH($GET(NODE))
SET ORKUSRN=$PIECE(NODE,U)
+14 ;
+15 ;get patient name:
+16 IF $LENGTH($GET(ORKPT))
SET NODE=$GET(^DPT(ORKPT,0))
IF $LENGTH($GET(NODE))
SET ORKPTN=$PIECE(NODE,U)
+17 ;
+18 ;get patient's location (INPATIENT ONLY - outpt locations cannot be
+19 ;reliably determined, and many simultaneous outpt locations can occur):
+20 IF +$GET(ORKPT)>0
Begin DoDot:1
+21 NEW DFN
SET DFN=ORKPT
SET VA200=""
DO OERR^VADPT
+22 SET ORKLOC=+$GET(^DIC(42,+VAIN(4),44))
IF +$GET(ORKLOC)>0
Begin DoDot:2
+23 SET ORKLOCN=$PIECE(^SC(+ORKLOC,0),U)
End DoDot:2
End DoDot:1
+24 KILL VA200,VAIN
+25 ;
+26 ;get user's service/section:
+27 SET ORKSRV=$GET(^VA(200,ORKUSR,5))
IF +ORKSRV>0
SET ORKSRV=$PIECE(ORKSRV,U)
Begin DoDot:1
+28 SET NODE=$GET(^DIC(49,ORKSRV,0))
IF $LENGTH($GET(NODE))
SET ORKSRVN=$PIECE(NODE,U)
End DoDot:1
+29 ;
+30 SET ORK="`"_ORK
+31 ;
+32 ;get user's flag:
+33 SET ORKUSRF=$$GET^XPAR("USR.`"_+$GET(ORKUSR),"ORK PROCESSING FLAG",ORK,"B")
+34 IF $LENGTH($GET(ORKUSRF))
QUIT $SELECT($PIECE(ORKUSRF,U)="D":"OFF",1:"ON")_"^User value is "_$PIECE(ORKUSRF,U,2)
+35 ;
+36 ;get patient location flag:
+37 IF +$GET(ORKLOC)>0
Begin DoDot:1
+38 SET ORKLOCF=$$GET^XPAR("LOC.`"_+$GET(ORKLOC),"ORK PROCESSING FLAG",ORK,"B")
End DoDot:1
+39 IF $LENGTH($GET(ORKLOCF))
QUIT $SELECT($PIECE(ORKLOCF,U)="D":"OFF",1:"ON")_"^Pt's location "_ORKLOCN_" value is "_$PIECE(ORKLOCF,U,2)
+40 ;
+41 ;get user's service flag:
+42 IF +$GET(ORKSRV)>0
Begin DoDot:1
+43 SET ORKSRVF=$$GET^XPAR("SRV.`"_+$GET(ORKSRV),"ORK PROCESSING FLAG",ORK,"B")
End DoDot:1
+44 IF $LENGTH($GET(ORKSRVF))
QUIT $SELECT($PIECE(ORKSRVF,U)="D":"OFF",1:"ON")_"^User's service "_ORKSRVN_" value is "_$PIECE(ORKSRVF,U,2)
+45 ;
+46 ;get user's division flag:
+47 SET ORKDIVF=$$GET^XPAR("DIV","ORK PROCESSING FLAG",ORK,"B")
+48 IF $LENGTH($GET(ORKDIVF))
QUIT $SELECT($PIECE(ORKDIVF,U)="D":"OFF",1:"ON")_"^Division value is "_$PIECE(ORKDIVF,U,2)
+49 ;
+50 ;get system flag:
+51 SET ORKSYSF=$$GET^XPAR("SYS","ORK PROCESSING FLAG",ORK,"B")
+52 IF $LENGTH($GET(ORKSYSF))
QUIT $SELECT($PIECE(ORKSYSF,U)="D":"OFF",1:"ON")_"^System value is "_$PIECE(ORKSYSF,U,2)
+53 ;
+54 ;get OE/RR package-exported flag:
+55 SET ORKPKGF=$$GET^XPAR("PKG","ORK PROCESSING FLAG",ORK,"B")
+56 IF $LENGTH($GET(ORKPKGF))
QUIT $SELECT($PIECE(ORKPKGF,U)="D":"OFF",1:"ON")_"^OERR value is "_$PIECE(ORKPKGF,U,2)
+57 ;
+58 QUIT "ON^No value found"
USRCHKS(ORKUSR) ; generate a list of order checks indicating user's recip status
+1 IF +$GET(ORKUSR)<1
SET ORKUSR=DUZ
+2 NEW ORY,ORYI,ORKY,ORKIEN,ORKNAM,NODE,ORX,DESC,HDR
+3 SET ORYI=1
+4 ;
+5 ;prompt for additional information:
+6 WRITE !!,"Would you like help understanding the list of order checks"
SET %=2
DO YN^DICN
IF %=1
DO HLPMSG
+7 KILL %
+8 ;
+9 ;see if order checking system is disabled:
+10 SET ORX=$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")
+11 IF ORX="D"
Begin DoDot:1
+12 SET ORY(ORYI)="Order Checking is disabled. No order checks will be processed or displayed."
+13 SET NODE=$GET(^VA(200,ORKUSR,0))
IF $LENGTH($GET(NODE))
SET HDR="Order Check List for "_$PIECE(NODE,U)
+14 SET DESC="Order check possibilities for a user"
+15 DO OUTPUT(.ORY,DESC,HDR)
End DoDot:1
+16 IF ORX="D"
QUIT
+17 ;
+18 WRITE !!,"This will take a moment or two, please stand by."
+19 ;
+20 SET ORY(ORYI)="Order Check ON/OFF For This User and Why"
SET ORYI=ORYI+1
+21 SET ORY(ORYI)="-------------------------------- ---------------------------------------------"
SET ORYI=ORYI+1
+22 ;
+23 ;loop thru all order checks and determine recipient status:
+24 SET ORKNAM=""
FOR
SET ORKNAM=$ORDER(^ORD(100.8,"B",ORKNAM))
IF ORKNAM=""
QUIT
Begin DoDot:1
+25 SET ORKIEN=0
SET ORKIEN=$ORDER(^ORD(100.8,"B",ORKNAM,ORKIEN))
IF +$GET(ORKIEN)>0
Begin DoDot:2
+26 SET ORKY(ORKNAM)=ORKIEN
+27 SET ORX=$$ONOFF(ORKIEN,ORKUSR,"")
IF $LENGTH($GET(ORX))
Begin DoDot:3
+28 WRITE "."
+29 SET ORKNAM=$EXTRACT(ORKNAM_" ",1,32)
+30 SET ORY(ORYI)=ORKNAM_" "_$EXTRACT($PIECE(ORX,U)_" ",1,5)_$PIECE(ORX,U,2)
SET ORYI=ORYI+1
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 SET ORYI=ORYI+1
SET ORY(ORYI)=""
SET ORYI=ORYI+1
SET ORY(ORYI)=""
SET ORYI=ORYI+1
+33 SET DESC="Order check possibilities for a user"
+34 SET NODE=$GET(^VA(200,ORKUSR,0))
IF $LENGTH($GET(NODE))
SET HDR="Order Check List for "_$PIECE(NODE,U)
+35 DO OUTPUT(.ORY,DESC,HDR)
+36 QUIT
HLPMSG ;display/print help message for a user's order checks
+1 NEW ORY,ORYI
+2 SET ORYI=1
+3 SET ORY(ORYI)="The delivery of order checks is determined from values set for Users,"
SET ORYI=ORYI+1
+4 SET ORY(ORYI)="Inpatient Locations, Service/Sections, Hospital Divisions, Computer System and"
SET ORYI=ORYI+1
+5 SET ORY(ORYI)="OERR. Possible values include 'Enabled' and 'Disabled'. These values indicate"
SET ORYI=ORYI+1
+6 SET ORY(ORYI)="a User's, Location's, Service/Section's, Division's, System's and OERR's"
SET ORYI=ORYI+1
+7 SET ORY(ORYI)="desire for the order check to be 'Enabled' (displayed under most"
SET ORYI=ORYI+1
+8 SET ORY(ORYI)="circumstances) or 'Disabled' (normally not displayed.)"
SET ORYI=ORYI+1
+9 SET ORY(ORYI)=""
SET ORYI=ORYI+1
+10 SET ORY(ORYI)="All values, except the OERR (Order Entry) value, can be set by IRM"
SET ORYI=ORYI+1
+11 SET ORY(ORYI)="or Clinical Coordinators. Individual users can set their 'Enabled/Disabled'"
SET ORYI=ORYI+1
+12 SET ORY(ORYI)="values for each specific order check via the 'Enable/Disable My Order Checks'"
SET ORYI=ORYI+1
+13 SET ORY(ORYI)="option under the Personal Preferences and Order Check Management for Users."
SET ORYI=ORYI+1
+14 SET ORY(ORYI)="'ON' indicates the user will receive the order check under normal conditions."
SET ORYI=ORYI+1
+15 SET ORY(ORYI)="'OFF' indicates the user normally will not receive the order check."
SET ORYI=ORYI+1
+16 SET ORY(ORYI)="Order check recipient determination can also be influenced by patient"
SET ORYI=ORYI+1
+17 SET ORY(ORYI)="location (inpatients only.) This list does not consider patient location"
SET ORYI=ORYI+1
+18 SET ORY(ORYI)="when calculating the ON/OFF value for an order check because a patient is"
SET ORYI=ORYI+1
+19 SET ORY(ORYI)="not known when the option is selected."
SET ORYI=ORYI+1
+20 SET ORY(ORYI)=""
SET ORYI=ORYI+1
SET ORY(ORYI)=""
SET ORYI=ORYI+1
+21 SET DESC="Help Message - order check possibilities for a user"
+22 SET HDR="Order Check List Help Message"
+23 DO OUTPUT(.ORY,DESC,HDR)
+24 QUIT
OUTPUT(ORY,ORKDESC,ORKHDR) ;prompt for device and send report
+1 NEW POP,ORBHDR
+2 NEW ZTRTN,ZTSAVE,ZTDESC
+3 ;prompt for device:
+4 ;prompt for Queueing
SET %ZIS="Q"
+5 DO ^%ZIS
+6 IF $GET(POP)>0
QUIT
+7 ;queue the report
IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="PRINT^ORB3U1"
+9 SET ORBHDR=ORKHDR
+10 SET ZTSAVE("ORY(")=""
SET ZTSAVE("ORBHDR")=""
+11 SET ZTDESC=ORKDESC
+12 DO ^%ZTLOAD
+13 IF $DATA(ZTSK)[0
WRITE !!?5,"Report canceled!"
+14 IF '$TEST
WRITE !!?5,"Report queued."
+15 DO HOME^%ZIS
End DoDot:1
+16 KILL %ZIS
+17 IF $DATA(IO("Q"))
KILL IO("Q")
QUIT
PRINT ;print body of List User's Order checks Report
+1 NEW END,PAGE,I,X
+2 SET (END,PAGE,I)=0
+3 USE IO
+4 DO @("HDR"_(2-($EXTRACT(IOST,1,2)="C-")))
+5 FOR
SET I=$ORDER(ORY(I))
IF I=""!(END=1)
QUIT
Begin DoDot:1
+6 IF $Y+5>IOSL
DO HDR
+7 IF END=1
QUIT
+8 WRITE !,ORY(I)
End DoDot:1
+9 IF END=1
WRITE !!," - Report Interrupted -",!
+10 IF '$TEST
WRITE " - End of Report -",!
+11 IF ($EXTRACT(IOST,1,2)="C-")
WRITE !,"Press RETURN to continue: "
READ X:DTIME
+12 DO ^%ZISC
+13 IF $GET(ZTSK)
DO KILL^%ZTLOAD
+14 QUIT
HDR ;print header of report
+1 IF PAGE
IF ($EXTRACT(IOST,1,2)="C-")
Begin DoDot:1
+2 WRITE !,"Press RETURN to continue or '^' to exit: "
+3 READ X:DTIME
SET END='$TEST!(X="^")
End DoDot:1
+4 IF END=1
QUIT
HDR1 IF '($EXTRACT(IOST,1,2)='"C-"&'PAGE)
WRITE @IOF
HDR2 SET PAGE=PAGE+1
WRITE ?20,ORKHDR
+1 WRITE ?(IOM-10),"Page: ",$JUSTIFY(PAGE,3),!!
+2 QUIT
