ORPRS06 ; slc/dcm - Driving Miss ChartCopy ;7/28/06 15:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,99,215,260**;Dec 17, 1997;Build 26
;
; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
;
MAIN ; Control module
N %,%H,%I,%T,ORDT,ORNOW,OREARLY,ORLATE,ORHPRM,ORLOC,X,X1,X2
N ORSC,ORSSC,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ORPCCS,ORPCCP,ORCONTX
D NOW^%DTC
S ORDT=$P(%,"."),ORNOW=$P(%,".",2)
I $E(ORNOW,1,2)>14 S OREARLY=ORDT
E S X1=ORDT,X2=-1 D C^%DTC S OREARLY=X
S X1=OREARLY,X2=1
D C^%DTC
S ORLATE=X,ORCONTX=21
D ENVAL^XPAR(.ORPCCS,"ORPF PRINT CHART COPY SUMMARY")
D ENVAL^XPAR(.ORPCCP,"ORPF CHART COPY PRINT DEVICE")
S ORSC="" F S ORSC=$O(ORPCCS(ORSC)) Q:ORSC="" I ORPCCS(ORSC,1),$G(ORPCCP(ORSC,1)) D
. S ORHPRM=ORPCCP(ORSC,1),ORSSC=+ORSC,ORLOC=$S(+$G(^SC(ORSSC,42)):$P($G(^DIC(42,+$G(^SC(ORSSC,42)),0)),U),1:$P($G(^SC(ORSSC,0)),U)_"^"_1)
. S ZTRTN=$S($L(ORLOC,U)=2:"CLINIC^ORPRS06",1:"WARD^ORPRS06"),ZTDTH=$H
. S ZTIO="`"_+ORHPRM,ZTSAVE("OR*")=""
. S ZTDESC="Chart copy of orders for "_ORLOC
. D ^%ZTLOAD
Q
WARD ; Gets list of patients for a specified non-clinic ward
N DFN,ORDLRJ,X,Y
I $S('$L(ORLOC):1,'$O(^DPT("CN",ORLOC,0)):1,1:0) Q
S ORDLRJ=$J,DFN=0
F S DFN=$O(^DPT("CN",ORLOC,DFN)) Q:'DFN D PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$G(ORCONTX),$G(ORSSC))
D ^%ZISC
I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
Q
CLINIC ; Sets up call for clinic patients
N ORAPT,ORERR,ORI
K ^TMP($J,"SDAMA202","GETPLIST")
D GETPLIST^SDAMA202(ORSSC,"1;4","",9999999-OREARLY,9999999-ORLATE) ;DBIA 3869
S ORERR=$$CLINERR^ORQRY01
I $L(ORERR) D Q
. N XMDUZ,XMSUB,XMTEXT,XMY K XMY,^TMP("OR SCHED DB ERROR",$J)
. S XMDUZ=.5
. S XMY(.5)=""
. S XMSUB=ORERR
. S XMTEXT="^TMP(""OR SCHED DB ERROR"",$J,0,"
. S ^TMP("OR SCHED DB ERROR",$J,0,1,0)=ORERR
. S ^TMP("OR SCHED DB ERROR",$J,0,2,0)=""
. D ^XMD
. K ^TMP("OR SCHED DB ERROR",$J)
S ORI=0
F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D
. S ORAPT=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
. S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))
. I ORAPT,DFN D PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$G(ORCONTX),$G(ORSSC))
K ^TMP($J,"SDAMA202","GETPLIST")
D ^%ZISC
I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
Q
PATIENT(DFN,EARLY,LATE,DEVICE,CONTEXT,LOC44) ; Gets orders by patient, date, context
;DFN=ptr to file 2
;EARLY=Starting date
;LATE=Ending date
;DEVICE=device to print on.
;CONTEXT=context sent to ORQ1 (default=1)
;LOC44=ptr to location, file 44
N ARRAY,ORVP
S ORVP=DFN_";DPT("
S:'$G(CONTEXT) CONTEXT=1
D EN^ORQ1(ORVP,1,CONTEXT,"",LATE,EARLY,0,1)
I $$GET^XPAR("ALL","ORPF CHART SUMMARY SORT",1,"I") D SORT^ORPRS02
I '$O(^TMP("ORR",$J,ORLIST,0)) G PATX
S ARRAY="^TMP(""ORR"",$J,ORLIST)",LOC44=$S($G(LOC44):LOC44_";SC(",1:"")
D GUI^ORPR02(.ARRAY,DEVICE,"C",LOC44,1)
PATX ;
K ^TMP("ORR",$J,ORLIST)
Q
WORK(DFN,EARLY,LATE,DEVICE) ;Gets orders for work copy
;Same description as PATIENT()
N ARRAY,ORVP
S ORVP=DFN_";DPT("
D EN^ORQ1(ORVP,1,1,"",LATE,EARLY,0,1)
I $$GET^XPAR("ALL","ORPF WORK SUMMARY SORT",1,"I") D SORT^ORPRS02
I '$O(^TMP("ORR",$J,ORLIST,0)) G WRKX
S ARRAY="^TMP(""ORR"",$J,ORLIST)"
D GUI^ORPR02(.ARRAY,DEVICE,"W",,1)
WRKX ;
K ^TMP("ORR",$J,ORLIST)
Q
ORPRS06 ; slc/dcm - Driving Miss ChartCopy ;7/28/06 15:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,99,215,260**;Dec 17, 1997;Build 26
+2 ;
+3 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
+4 ;
MAIN ; Control module
+1 NEW %,%H,%I,%T,ORDT,ORNOW,OREARLY,ORLATE,ORHPRM,ORLOC,X,X1,X2
+2 NEW ORSC,ORSSC,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ORPCCS,ORPCCP,ORCONTX
+3 DO NOW^%DTC
+4 SET ORDT=$PIECE(%,".")
SET ORNOW=$PIECE(%,".",2)
+5 IF $EXTRACT(ORNOW,1,2)>14
SET OREARLY=ORDT
+6 IF '$TEST
SET X1=ORDT
SET X2=-1
DO C^%DTC
SET OREARLY=X
+7 SET X1=OREARLY
SET X2=1
+8 DO C^%DTC
+9 SET ORLATE=X
SET ORCONTX=21
+10 DO ENVAL^XPAR(.ORPCCS,"ORPF PRINT CHART COPY SUMMARY")
+11 DO ENVAL^XPAR(.ORPCCP,"ORPF CHART COPY PRINT DEVICE")
+12 SET ORSC=""
FOR
SET ORSC=$ORDER(ORPCCS(ORSC))
IF ORSC=""
QUIT
IF ORPCCS(ORSC,1)
IF $GET(ORPCCP(ORSC,1))
Begin DoDot:1
+13 SET ORHPRM=ORPCCP(ORSC,1)
SET ORSSC=+ORSC
SET ORLOC=$SELECT(+$GET(^SC(ORSSC,42)):$PIECE($GET(^DIC(42,+$GET(^SC(ORSSC,42)),0)),U),1:$PIECE($GET(^SC(ORSSC,0)),U)_"^"_1)
+14 SET ZTRTN=$SELECT($LENGTH(ORLOC,U)=2:"CLINIC^ORPRS06",1:"WARD^ORPRS06")
SET ZTDTH=$HOROLOG
+15 SET ZTIO="`"_+ORHPRM
SET ZTSAVE("OR*")=""
+16 SET ZTDESC="Chart copy of orders for "_ORLOC
+17 DO ^%ZTLOAD
End DoDot:1
+18 QUIT
WARD ; Gets list of patients for a specified non-clinic ward
+1 NEW DFN,ORDLRJ,X,Y
+2 IF $SELECT('$LENGTH(ORLOC):1,'$ORDER(^DPT("CN",ORLOC,0)):1,1:0)
QUIT
+3 SET ORDLRJ=$JOB
SET DFN=0
+4 FOR
SET DFN=$ORDER(^DPT("CN",ORLOC,DFN))
IF 'DFN
QUIT
DO PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$GET(ORCONTX),$GET(ORSSC))
+5 DO ^%ZISC
+6 IF $DATA(ZTSK)
DO KILL^%ZTLOAD
KILL ZTSK
+7 QUIT
CLINIC ; Sets up call for clinic patients
+1 NEW ORAPT,ORERR,ORI
+2 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+3 ;DBIA 3869
DO GETPLIST^SDAMA202(ORSSC,"1;4","",9999999-OREARLY,9999999-ORLATE)
+4 SET ORERR=$$CLINERR^ORQRY01
+5 IF $LENGTH(ORERR)
Begin DoDot:1
+6 NEW XMDUZ,XMSUB,XMTEXT,XMY
KILL XMY,^TMP("OR SCHED DB ERROR",$JOB)
+7 SET XMDUZ=.5
+8 SET XMY(.5)=""
+9 SET XMSUB=ORERR
+10 SET XMTEXT="^TMP(""OR SCHED DB ERROR"",$J,0,"
+11 SET ^TMP("OR SCHED DB ERROR",$JOB,0,1,0)=ORERR
+12 SET ^TMP("OR SCHED DB ERROR",$JOB,0,2,0)=""
+13 DO ^XMD
+14 KILL ^TMP("OR SCHED DB ERROR",$JOB)
End DoDot:1
QUIT
+15 SET ORI=0
+16 FOR
SET ORI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",ORI))
IF ORI<1
QUIT
Begin DoDot:1
+17 SET ORAPT=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,1))
+18 SET DFN=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",ORI,4))
+19 IF ORAPT
IF DFN
DO PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$GET(ORCONTX),$GET(ORSSC))
End DoDot:1
+20 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+21 DO ^%ZISC
+22 IF $DATA(ZTSK)
DO KILL^%ZTLOAD
KILL ZTSK
+23 QUIT
PATIENT(DFN,EARLY,LATE,DEVICE,CONTEXT,LOC44) ; Gets orders by patient, date, context
+1 ;DFN=ptr to file 2
+2 ;EARLY=Starting date
+3 ;LATE=Ending date
+4 ;DEVICE=device to print on.
+5 ;CONTEXT=context sent to ORQ1 (default=1)
+6 ;LOC44=ptr to location, file 44
+7 NEW ARRAY,ORVP
+8 SET ORVP=DFN_";DPT("
+9 IF '$GET(CONTEXT)
SET CONTEXT=1
+10 DO EN^ORQ1(ORVP,1,CONTEXT,"",LATE,EARLY,0,1)
+11 IF $$GET^XPAR("ALL","ORPF CHART SUMMARY SORT",1,"I")
DO SORT^ORPRS02
+12 IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
GOTO PATX
+13 SET ARRAY="^TMP(""ORR"",$J,ORLIST)"
SET LOC44=$SELECT($GET(LOC44):LOC44_";SC(",1:"")
+14 DO GUI^ORPR02(.ARRAY,DEVICE,"C",LOC44,1)
PATX ;
+1 KILL ^TMP("ORR",$JOB,ORLIST)
+2 QUIT
WORK(DFN,EARLY,LATE,DEVICE) ;Gets orders for work copy
+1 ;Same description as PATIENT()
+2 NEW ARRAY,ORVP
+3 SET ORVP=DFN_";DPT("
+4 DO EN^ORQ1(ORVP,1,1,"",LATE,EARLY,0,1)
+5 IF $$GET^XPAR("ALL","ORPF WORK SUMMARY SORT",1,"I")
DO SORT^ORPRS02
+6 IF '$ORDER(^TMP("ORR",$JOB,ORLIST,0))
GOTO WRKX
+7 SET ARRAY="^TMP(""ORR"",$J,ORLIST)"
+8 DO GUI^ORPR02(.ARRAY,DEVICE,"W",,1)
WRKX ;
+1 KILL ^TMP("ORR",$JOB,ORLIST)
+2 QUIT
