source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS06.m@ 1739

Last change on this file since 1739 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1ORPRS06 ; slc/dcm - Driving Miss ChartCopy ;7/28/06 15:55
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,99,215,260**;Dec 17, 1997;Build 26
3 ;
4 ; DBIA 3869 GETPLIST^SDAMA202 ^TMP($J,"SDAMA202")
5 ;
6MAIN ; Control module
7 N %,%H,%I,%T,ORDT,ORNOW,OREARLY,ORLATE,ORHPRM,ORLOC,X,X1,X2
8 N ORSC,ORSSC,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ORPCCS,ORPCCP,ORCONTX
9 D NOW^%DTC
10 S ORDT=$P(%,"."),ORNOW=$P(%,".",2)
11 I $E(ORNOW,1,2)>14 S OREARLY=ORDT
12 E S X1=ORDT,X2=-1 D C^%DTC S OREARLY=X
13 S X1=OREARLY,X2=1
14 D C^%DTC
15 S ORLATE=X,ORCONTX=21
16 D ENVAL^XPAR(.ORPCCS,"ORPF PRINT CHART COPY SUMMARY")
17 D ENVAL^XPAR(.ORPCCP,"ORPF CHART COPY PRINT DEVICE")
18 S ORSC="" F S ORSC=$O(ORPCCS(ORSC)) Q:ORSC="" I ORPCCS(ORSC,1),$G(ORPCCP(ORSC,1)) D
19 . 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)
20 . S ZTRTN=$S($L(ORLOC,U)=2:"CLINIC^ORPRS06",1:"WARD^ORPRS06"),ZTDTH=$H
21 . S ZTIO="`"_+ORHPRM,ZTSAVE("OR*")=""
22 . S ZTDESC="Chart copy of orders for "_ORLOC
23 . D ^%ZTLOAD
24 Q
25WARD ; Gets list of patients for a specified non-clinic ward
26 N DFN,ORDLRJ,X,Y
27 I $S('$L(ORLOC):1,'$O(^DPT("CN",ORLOC,0)):1,1:0) Q
28 S ORDLRJ=$J,DFN=0
29 F S DFN=$O(^DPT("CN",ORLOC,DFN)) Q:'DFN D PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$G(ORCONTX),$G(ORSSC))
30 D ^%ZISC
31 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
32 Q
33CLINIC ; Sets up call for clinic patients
34 N ORAPT,ORERR,ORI
35 K ^TMP($J,"SDAMA202","GETPLIST")
36 D GETPLIST^SDAMA202(ORSSC,"1;4","",9999999-OREARLY,9999999-ORLATE) ;DBIA 3869
37 S ORERR=$$CLINERR^ORQRY01
38 I $L(ORERR) D Q
39 . N XMDUZ,XMSUB,XMTEXT,XMY K XMY,^TMP("OR SCHED DB ERROR",$J)
40 . S XMDUZ=.5
41 . S XMY(.5)=""
42 . S XMSUB=ORERR
43 . S XMTEXT="^TMP(""OR SCHED DB ERROR"",$J,0,"
44 . S ^TMP("OR SCHED DB ERROR",$J,0,1,0)=ORERR
45 . S ^TMP("OR SCHED DB ERROR",$J,0,2,0)=""
46 . D ^XMD
47 . K ^TMP("OR SCHED DB ERROR",$J)
48 S ORI=0
49 F S ORI=$O(^TMP($J,"SDAMA202","GETPLIST",ORI)) Q:ORI<1 D
50 . S ORAPT=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,1))
51 . S DFN=+$G(^TMP($J,"SDAMA202","GETPLIST",ORI,4))
52 . I ORAPT,DFN D PATIENT(DFN,OREARLY,ORLATE,ORHPRM,$G(ORCONTX),$G(ORSSC))
53 K ^TMP($J,"SDAMA202","GETPLIST")
54 D ^%ZISC
55 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
56 Q
57PATIENT(DFN,EARLY,LATE,DEVICE,CONTEXT,LOC44) ; Gets orders by patient, date, context
58 ;DFN=ptr to file 2
59 ;EARLY=Starting date
60 ;LATE=Ending date
61 ;DEVICE=device to print on.
62 ;CONTEXT=context sent to ORQ1 (default=1)
63 ;LOC44=ptr to location, file 44
64 N ARRAY,ORVP
65 S ORVP=DFN_";DPT("
66 S:'$G(CONTEXT) CONTEXT=1
67 D EN^ORQ1(ORVP,1,CONTEXT,"",LATE,EARLY,0,1)
68 I $$GET^XPAR("ALL","ORPF CHART SUMMARY SORT",1,"I") D SORT^ORPRS02
69 I '$O(^TMP("ORR",$J,ORLIST,0)) G PATX
70 S ARRAY="^TMP(""ORR"",$J,ORLIST)",LOC44=$S($G(LOC44):LOC44_";SC(",1:"")
71 D GUI^ORPR02(.ARRAY,DEVICE,"C",LOC44,1)
72PATX ;
73 K ^TMP("ORR",$J,ORLIST)
74 Q
75WORK(DFN,EARLY,LATE,DEVICE) ;Gets orders for work copy
76 ;Same description as PATIENT()
77 N ARRAY,ORVP
78 S ORVP=DFN_";DPT("
79 D EN^ORQ1(ORVP,1,1,"",LATE,EARLY,0,1)
80 I $$GET^XPAR("ALL","ORPF WORK SUMMARY SORT",1,"I") D SORT^ORPRS02
81 I '$O(^TMP("ORR",$J,ORLIST,0)) G WRKX
82 S ARRAY="^TMP(""ORR"",$J,ORLIST)"
83 D GUI^ORPR02(.ARRAY,DEVICE,"W",,1)
84WRKX ;
85 K ^TMP("ORR",$J,ORLIST)
86 Q
Note: See TracBrowser for help on using the repository browser.