MDSTUDW ; HOIFO/NCA - Print a List of Procedures With Incomplete Workload ;3/2/09 10:00
;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
; Integration Agreements:
; IA #1894 [Subscription] PXAPI call
; IA# 10103 [Supported] XLFDT calls
; IA# 10061 [Supported] VADPT calls
; IA# 10062 [Supported] VADPT6 calls
; IA# 4869 [Private] ^DIC(45.7,
;
E1 ; Get Start Date
N MDSDT,MDEDT
S %DT("A")="Select Start Date: ",%DT="AEX" W ! D ^%DT G EX:"^"[X!$D(DTOUT),E1:Y<1 S MDSDT=+Y
E2 S %DT("A")="Select End Date: ",%DT="AEX" W ! D ^%DT G EX:"^"[X!$D(DTOUT),E2:Y<1
I +Y<MDSDT W !!,"***End Date must be on or after Start Date!!!" G E2
S MDEDT=+Y+.24
EN2 ; Print a list of Procedures with incomplete Workload
N DIC,MDSPEC,X,Y,DTOUT,DUOUT
S1 R !!,"Select Facility Treating Specialty (or ALL): ",X:DTIME Q:'$T!("^"[X) S:X="all" X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") I X="ALL" S MDSPEC=0
E K DIC S DIC="^DIC(45.7,",DIC(0)="EMQ" D ^DIC G:Y<1!($D(DTOUT))!($D(DUOUT)) S1 S MDSPEC=+Y K DIC W !
K IOP S %ZIS="MQ",%ZIS("A")="Select LIST Printer: ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP Q:POP
I $D(IO("Q")) D QUE Q
U IO D GETTRAN D ^%ZISC K %ZIS,IOP Q
QUE ; Queue List
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE,ZTDESC,ZTSK S ZTRTN="GETTRAN^MDSTUDW",ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("MDSPEC")="",ZTSAVE("MDSDT")="",ZTSAVE("MDEDT")=""
S:$D(XQY0) ZTDESC=$P(XQY0,"^",1)
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",! K ZTSK Q
EX ; Exit
Q
GETTRAN ; [Procedure] Loop through Results by Date/Time Performed
K ^TMP("MDSTUDW",$J)
N ANS,BID,DFN,DTP,LN,MDL,MDL1,MDCHKD,MDCHKDT,MDCOM,MDCNST,MDCOMP,MDDEFN,MDNUM,MDPNAM,MDREQ,MDANOD,MDBNOD,MDCNOD,MDSP,MDTXT,MDVS,MDVST,MDX,PG,S1,X1,X2,X,Y0,Z
N MDCT,MDLOP,MDOK,MDOK1,MDOK2,MDVDT S S1=$S(IOST?1"C".E:IOSL-8,1:IOSL-7)
S LN="",$P(LN,"-",79)="",MDCOM=0
S PG=0 N % D NOW^%DTC S DTP=%,DTP=$$FMTE^XLFDT(DTP,"1P")
S MDL=MDSDT F S MDL=$O(^MDD(703.1,"ADTP",MDL)) Q:'MDL!(MDL>MDEDT) F MDL1=0:0 S MDL1=$O(^MDD(703.1,"ADTP",MDL,MDL1)) Q:MDL1<1 D
.S (MDANOD,MDBNOD,MDCNOD)=""
.S MDCOM=$P($G(^MDD(703.1,+MDL1,0)),"^",5)
.S MDVST=+$G(^MDD(702,+MDCOM,1)) Q:'MDVST
.D ENCEVENT^PXAPI(MDVST) S (MDOK,MDOK1,MDOK2)=0
.I $D(^TMP("PXKENC",$J,MDVST,"POV")) S MDOK=1
.I $D(^TMP("PXKENC",$J,MDVST,"CPT")) S MDOK1=1
.I $D(^TMP("PXKENC",$J,MDVST,"PRV")) S MDOK2=1
.S MDVS=$O(^TMP("PXKENC",$J,MDVST,"VST",0))
.S MDVDT=$P($G(^TMP("PXKENC",$J,MDVST,"VST",+MDVS,0)),"^",1)
.K ^TMP("PXKENC",$J)
.Q:(MDOK+MDOK1+MDOK2)=3
.S DFN=+$P($G(^MDD(702,+MDCOM,0)),"^") D DEM^VADPT S MDPNAM=$G(VADM(1)) K VADM D PID^VADPT6 S BID=$G(VA("BID")) K VA
.S MDBNOD=$S($L(MDPNAM)>24:$E(MDPNAM,1,24),1:MDPNAM)_" ("_BID_")",MDCNST=$P($G(^MDD(702,+MDCOM,0)),"^",5)
.S MDANOD="UNASSIGNED",MDSP=+$$GET1^DIQ(702,+MDCOM,".04:.02","I")
.I +MDSP Q:+MDSPEC>0&(+MDSPEC'=+MDSP) S MDANOD=$$GET1^DIQ(702,+MDCOM,".04:.02")
.I +$$GET1^DIQ(702,+MDCOM,.04,"I") S MDDEFN=$$GET1^DIQ(702,+MDCOM,.04),MDCNOD=MDVDT_"~"_MDBNOD
.S MDANOD=MDANOD_"~"_MDDEFN
.S Z=$$FMTE^XLFDT(MDVDT,"2MZ")_"^"_MDCNST_"^"_+$P($G(^MDD(702,+MDCOM,0)),"^",6)_"^"_MDVST_"^"_$S('MDOK:"Diagnosis",1:"")_"^"_$S('MDOK1:"CPT",1:"")_"^"_$S('MDOK2:"Provider",1:"")
.I '$D(^TMP("MDSTUDW",$J,MDANOD,MDCNOD)) S ^TMP("MDSTUDW",$J,MDANOD,MDCNOD)=Z
.Q
I '$D(^TMP("MDSTUDW",$J)) S (ANS,MDANOD,MDLOP)="" D HDR W !!,"No procedures with incomplete workload found."
N MDCT S MDCT=0,(ANS,MDCHKD)=""
N MDLOP S MDLOP="" F S MDLOP=$O(^TMP("MDSTUDW",$J,MDLOP)) Q:MDLOP=""!(ANS="^") D
.D HDR
.S MDANOD="" F S MDANOD=$O(^TMP("MDSTUDW",$J,MDLOP,MDANOD)) Q:MDANOD=""!(ANS="^") D
..S Y0=$G(^TMP("MDSTUDW",$J,MDLOP,MDANOD))
..D:$Y>(IOSL-8) HDR Q:ANS="^"
..I MDCHKD'=$P(MDLOP,"~",2) W !,"PROCEDURE: ",$P(MDLOP,"~",2),! S MDCHKD=$P(MDLOP,"~",2)
..D:$Y'<S1 PAUSE Q:ANS="^"
..W !,$P(Y0,U),?18,$P(MDANOD,"~",2),?52,$P(Y0,U,2),?62,$P(Y0,U,3)
..I $P(Y0,U,5)'="" W ?69,$P(Y0,U,5)
..I $P(Y0,U,6)'="" W !?69,$P(Y0,U,6)
..I $P(Y0,U,7)'="" W !?69,$P(Y0,U,7)
..W ! Q
.Q
K ^TMP("MDSTUDL",$J)
Q
HDR ; List Header
Q:ANS="^" D:$Y'<S1 PAUSE Q:ANS="^"
W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
W !,DTP,?73,"Page ",PG,!!?5,"P R O C E D U R E S W I T H I N C O M P L E T E W O R K L O A D",!!
S Y=$S($P(MDLOP,"~")="UNASSIGNED":"",1:$P(MDLOP,"~")) W:Y'="" !?(78-$L(Y)\2),Y,!
W !,"Visit D/T",?18,"Patient",?50,"Consult #",?62,"TIU #",?69,"MISSING",!,LN
Q
PAUSE ; Pause For Scroll
I IOST?1"C".E K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR I 'Y S ANS="^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDSTUDW 4559 printed Apr 09, 2024@20:48:17 Page 2
MDSTUDW ; HOIFO/NCA - Print a List of Procedures With Incomplete Workload ;3/2/09 10:00
+1 ;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
+2 ; Integration Agreements:
+3 ; IA #1894 [Subscription] PXAPI call
+4 ; IA# 10103 [Supported] XLFDT calls
+5 ; IA# 10061 [Supported] VADPT calls
+6 ; IA# 10062 [Supported] VADPT6 calls
+7 ; IA# 4869 [Private] ^DIC(45.7,
+8 ;
E1 ; Get Start Date
+1 NEW MDSDT,MDEDT
+2 SET %DT("A")="Select Start Date: "
SET %DT="AEX"
WRITE !
DO ^%DT
if "^"[X!$DATA(DTOUT)
GOTO EX
if Y<1
GOTO E1
SET MDSDT=+Y
E2 SET %DT("A")="Select End Date: "
SET %DT="AEX"
WRITE !
DO ^%DT
if "^"[X!$DATA(DTOUT)
GOTO EX
if Y<1
GOTO E2
+1 IF +Y<MDSDT
WRITE !!,"***End Date must be on or after Start Date!!!"
GOTO E2
+2 SET MDEDT=+Y+.24
EN2 ; Print a list of Procedures with incomplete Workload
+1 NEW DIC,MDSPEC,X,Y,DTOUT,DUOUT
S1 READ !!,"Select Facility Treating Specialty (or ALL): ",X:DTIME
if '$TEST!("^"[X)
QUIT
if X="all"
SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
IF X="ALL"
SET MDSPEC=0
+1 IF '$TEST
KILL DIC
SET DIC="^DIC(45.7,"
SET DIC(0)="EMQ"
DO ^DIC
if Y<1!($DATA(DTOUT))!($DATA(DUOUT))
GOTO S1
SET MDSPEC=+Y
KILL DIC
WRITE !
+2 KILL IOP
SET %ZIS="MQ"
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS("B")="HOME"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
QUIT
+3 IF $DATA(IO("Q"))
DO QUE
QUIT
+4 USE IO
DO GETTRAN
DO ^%ZISC
KILL %ZIS,IOP
QUIT
QUE ; Queue List
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE,ZTDESC,ZTSK
SET ZTRTN="GETTRAN^MDSTUDW"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
SET ZTSAVE("MDSPEC")=""
SET ZTSAVE("MDSDT")=""
SET ZTSAVE("MDEDT")=""
+2 if $DATA(XQY0)
SET ZTDESC=$PIECE(XQY0,"^",1)
+3 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
KILL ZTSK
QUIT
EX ; Exit
+1 QUIT
GETTRAN ; [Procedure] Loop through Results by Date/Time Performed
+1 KILL ^TMP("MDSTUDW",$JOB)
+2 NEW ANS,BID,DFN,DTP,LN,MDL,MDL1,MDCHKD,MDCHKDT,MDCOM,MDCNST,MDCOMP,MDDEFN,MDNUM,MDPNAM,MDREQ,MDANOD,MDBNOD,MDCNOD,MDSP,MDTXT,MDVS,MDVST,MDX,PG,S1,X1,X2,X,Y0,Z
+3 NEW MDCT,MDLOP,MDOK,MDOK1,MDOK2,MDVDT
SET S1=$SELECT(IOST?1"C".E:IOSL-8,1:IOSL-7)
+4 SET LN=""
SET $PIECE(LN,"-",79)=""
SET MDCOM=0
+5 SET PG=0
NEW %
DO NOW^%DTC
SET DTP=%
SET DTP=$$FMTE^XLFDT(DTP,"1P")
+6 SET MDL=MDSDT
FOR
SET MDL=$ORDER(^MDD(703.1,"ADTP",MDL))
if 'MDL!(MDL>MDEDT)
QUIT
FOR MDL1=0:0
SET MDL1=$ORDER(^MDD(703.1,"ADTP",MDL,MDL1))
if MDL1<1
QUIT
Begin DoDot:1
+7 SET (MDANOD,MDBNOD,MDCNOD)=""
+8 SET MDCOM=$PIECE($GET(^MDD(703.1,+MDL1,0)),"^",5)
+9 SET MDVST=+$GET(^MDD(702,+MDCOM,1))
if 'MDVST
QUIT
+10 DO ENCEVENT^PXAPI(MDVST)
SET (MDOK,MDOK1,MDOK2)=0
+11 IF $DATA(^TMP("PXKENC",$JOB,MDVST,"POV"))
SET MDOK=1
+12 IF $DATA(^TMP("PXKENC",$JOB,MDVST,"CPT"))
SET MDOK1=1
+13 IF $DATA(^TMP("PXKENC",$JOB,MDVST,"PRV"))
SET MDOK2=1
+14 SET MDVS=$ORDER(^TMP("PXKENC",$JOB,MDVST,"VST",0))
+15 SET MDVDT=$PIECE($GET(^TMP("PXKENC",$JOB,MDVST,"VST",+MDVS,0)),"^",1)
+16 KILL ^TMP("PXKENC",$JOB)
+17 if (MDOK+MDOK1+MDOK2)=3
QUIT
+18 SET DFN=+$PIECE($GET(^MDD(702,+MDCOM,0)),"^")
DO DEM^VADPT
SET MDPNAM=$GET(VADM(1))
KILL VADM
DO PID^VADPT6
SET BID=$GET(VA("BID"))
KILL VA
+19 SET MDBNOD=$SELECT($LENGTH(MDPNAM)>24:$EXTRACT(MDPNAM,1,24),1:MDPNAM)_" ("_BID_")"
SET MDCNST=$PIECE($GET(^MDD(702,+MDCOM,0)),"^",5)
+20 SET MDANOD="UNASSIGNED"
SET MDSP=+$$GET1^DIQ(702,+MDCOM,".04:.02","I")
+21 IF +MDSP
if +MDSPEC>0&(+MDSPEC'=+MDSP)
QUIT
SET MDANOD=$$GET1^DIQ(702,+MDCOM,".04:.02")
+22 IF +$$GET1^DIQ(702,+MDCOM,.04,"I")
SET MDDEFN=$$GET1^DIQ(702,+MDCOM,.04)
SET MDCNOD=MDVDT_"~"_MDBNOD
+23 SET MDANOD=MDANOD_"~"_MDDEFN
+24 SET Z=$$FMTE^XLFDT(MDVDT,"2MZ")_"^"_MDCNST_"^"_+$PIECE($GET(^MDD(702,+MDCOM,0)),"^",6)_"^"_MDVST_"^"_$SELECT('MDOK:"Diagnosis",1:"")_"^"_$SELECT('MDOK1:"CPT",1:"")_"^"_$SELECT('MDOK2:"Provider",1:"")
+25 IF '$DATA(^TMP("MDSTUDW",$JOB,MDANOD,MDCNOD))
SET ^TMP("MDSTUDW",$JOB,MDANOD,MDCNOD)=Z
+26 QUIT
End DoDot:1
+27 IF '$DATA(^TMP("MDSTUDW",$JOB))
SET (ANS,MDANOD,MDLOP)=""
DO HDR
WRITE !!,"No procedures with incomplete workload found."
+28 NEW MDCT
SET MDCT=0
SET (ANS,MDCHKD)=""
+29 NEW MDLOP
SET MDLOP=""
FOR
SET MDLOP=$ORDER(^TMP("MDSTUDW",$JOB,MDLOP))
if MDLOP=""!(ANS="^")
QUIT
Begin DoDot:1
+30 DO HDR
+31 SET MDANOD=""
FOR
SET MDANOD=$ORDER(^TMP("MDSTUDW",$JOB,MDLOP,MDANOD))
if MDANOD=""!(ANS="^")
QUIT
Begin DoDot:2
+32 SET Y0=$GET(^TMP("MDSTUDW",$JOB,MDLOP,MDANOD))
+33 if $Y>(IOSL-8)
DO HDR
if ANS="^"
QUIT
+34 IF MDCHKD'=$PIECE(MDLOP,"~",2)
WRITE !,"PROCEDURE: ",$PIECE(MDLOP,"~",2),!
SET MDCHKD=$PIECE(MDLOP,"~",2)
+35 if $Y'<S1
DO PAUSE
if ANS="^"
QUIT
+36 WRITE !,$PIECE(Y0,U),?18,$PIECE(MDANOD,"~",2),?52,$PIECE(Y0,U,2),?62,$PIECE(Y0,U,3)
+37 IF $PIECE(Y0,U,5)'=""
WRITE ?69,$PIECE(Y0,U,5)
+38 IF $PIECE(Y0,U,6)'=""
WRITE !?69,$PIECE(Y0,U,6)
+39 IF $PIECE(Y0,U,7)'=""
WRITE !?69,$PIECE(Y0,U,7)
+40 WRITE !
QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 KILL ^TMP("MDSTUDL",$JOB)
+43 QUIT
HDR ; List Header
+1 if ANS="^"
QUIT
if $Y'<S1
DO PAUSE
if ANS="^"
QUIT
+2 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET PG=PG+1
+3 WRITE !,DTP,?73,"Page ",PG,!!?5,"P R O C E D U R E S W I T H I N C O M P L E T E W O R K L O A D",!!
+4 SET Y=$SELECT($PIECE(MDLOP,"~")="UNASSIGNED":"",1:$PIECE(MDLOP,"~"))
if Y'=""
WRITE !?(78-$LENGTH(Y)\2),Y,!
+5 WRITE !,"Visit D/T",?18,"Patient",?50,"Consult #",?62,"TIU #",?69,"MISSING",!,LN
+6 QUIT
PAUSE ; Pause For Scroll
+1 IF IOST?1"C".E
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue or '^' to Quit Listing"
DO ^DIR
IF 'Y
SET ANS="^"
+2 QUIT
