ORPRS06.m

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