GMTSPCD ; SLC/DLT,KER - Queue HS Batch Print Clinic by Date ; 08/27/2002 [1/26/05 11:22am]
;;2.7;Health Summary;**28,56,70**;Oct 20, 1995;Build 5
;
; External References
; DBIA 10026 ^DIR
; DBIA 10063 ^%ZTLOAD
; DBIA 10040 ^SC("B")
; DBIA 10040 ^SC( file #44
; DBIA 10006 ^DIC (file #44 and 3.5)
; DBIA 10000 NOW^%DTC
;
MAIN ; Controls branching
W !!,"This option will queue Health Summaries for a specified Visit Date"
W !,"for all Outpatient Clinics with Appointments on that Visit Date.",!!
N GMTSCDT
S GMTSCDT=$$SELDATE Q:GMTSCDT'>0
W ! N DIR S DIR(0)="D^::%DT",DIR("A")="Date and Time to Queue this Job to run",DIR("B")="NOW" D ^DIR Q:($D(DTOUT)!($D(DUOUT))!($D(DIROUT)))
S ZTDTH=Y,ZTIO="",ZTSAVE("GMTSCDT")=""
S ZTRTN="CLINICQ^GMTSPCD",ZTDESC="Create Task HS Jobs for Clinics by Visit Date"
D ^%ZTLOAD
Q
CLINICQ ; Loop thru clinics for appointments
; Date stored in GMTSCDT
N GMTSARR,GMTSCNT,GMTSLOC,GMTSCL,GMTSTYP,GMTSJ
;GET ALL APPOINTMENTS ON DATE GMTSCDT
S GMTSARR(1)=GMTSCDT_";"_GMTSCDT,GMTSARR("FLDS")="1;2",GMTSCNT=$$SDAPI^SDAMA301(.GMTSARR)
;IF ERROR IN SDAPI CALL, SEND MESSAGE AND QUIT
I GMTSCNT<0 D MAIL^GMTSMAIL("SCHEDULING DATABASE ERROR "_GMTSCNT,"HS Batch Print Clinic by Date") K ^TMP($J,"SDAMA301") Q
;LOOP THROUGH RETURN ARRAY AND SORT BY CLINIC NAME REMOVING ANY CLINIC THAT IS NOT OF TYPE "C"
I GMTSCNT>0 D
.N GMTSI S GMTSI=0 F S GMTSI=$O(^TMP($J,"SDAMA301",GMTSI)) Q:'GMTSI D
..Q:$P($G(^SC(GMTSI,0)),U,3)'="C"
..N NAME,DFN,TIME,TEMP,TYPE
..S DFN=$O(^TMP($J,"SDAMA301",GMTSI,0))
..S TIME=$O(^TMP($J,"SDAMA301",GMTSI,DFN,0))
..S TEMP=$P(^TMP($J,"SDAMA301",GMTSI,DFN,TIME),U,2)
..S NAME=$P(TEMP,";",2)
..S TYPE=0,TYPE=$O(^GMT(142,"D",GMTSI,TYPE))
..I +TYPE>0 S ^TMP($J,"GMTSCL",NAME,GMTSI,TYPE)=""
;LOOP THROUGH CLINICS ALPHABETICALLY AND CALL QUEUE WITH GMTSTYP AND GMTSCL SET
S GMTSJ="" F S GMTSJ=$O(^TMP($J,"GMTSCL",GMTSJ)) Q:'$L(GMTSJ) S GMTSCL=$O(^TMP($J,"GMTSCL",GMTSJ,0)) Q:'GMTSCL S GMTSTYP=$O(^TMP($J,"GMTSCL",GMTSJ,GMTSCL,0)) D QUEUE
K ^TMP($J,"GMTSCL"),^TMP($J,"SDAMA301")
Q
QUEUE ; Queues HS batch print for particular HS Type and Location.
N DIC,GMPSAP,GMTSCLI,GMTSLOC,GMTSSC,GMTSIO,GMTSDYS,GMV,QUEQIT,X,Y
S QUEQIT=0
S GMTSCLI=$O(^GMT(142,GMTSTYP,20,"B",GMTSCL,0))
S GMTSLOC=$G(^GMT(142,GMTSTYP,20,GMTSCLI,0))
S X=+GMTSLOC,DIC=44,DIC(0)="NXZ" D ^DIC
I $S(+Y'>0:1,"WCOR"'[$P($G(Y(0)),U,3):1,1:0) Q
S GMTSSC(1)=Y_U_$P(Y(0),U,3),$P(GMTSSC(1),U,4)=GMTSCDT
S GMPSAP=$S($P(GMTSLOC,U,3)="Y":1,1:0)
S ZTIO=$$GETIO($P(GMTSLOC,U,2)) Q:'$L(ZTIO)
S ZTDTH=$H,ZTRTN="MAIN^GMTSPL",ZTDESC="Clinic Health Summaries by Visit Date"
F GMV="GMTSTYP","GMPSAP" S ZTSAVE(GMV)=""
S ZTSAVE("GMTSSC(")=""
D ^%ZTLOAD
Q
GETIO(X) ; Get device for queueing
N %,%Y,C,DIC,Y
S DIC=3.5,DIC(0)="NXZ" D ^DIC S Y=$S(+Y'>0:"",1:$P(Y(0),U))
Q Y
SELDATE() ; Allows entry of Visit/Surgery date or date range
; for Print-by-Clinic
N %,%H,%I,DIR,DEFDT,X,Y
D NOW^%DTC S (X,DT)=$P(%,".") D REGDT4^GMTSU S DEFDT=X
S DIR(0)="D^::EX",DIR("B")=DEFDT
S DIR("A")="Please enter the Visit date"
D ^DIR
I Y="^^" S DIROUT=1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPCD 3203 printed Dec 13, 2024@01:59:08 Page 2
GMTSPCD ; SLC/DLT,KER - Queue HS Batch Print Clinic by Date ; 08/27/2002 [1/26/05 11:22am]
+1 ;;2.7;Health Summary;**28,56,70**;Oct 20, 1995;Build 5
+2 ;
+3 ; External References
+4 ; DBIA 10026 ^DIR
+5 ; DBIA 10063 ^%ZTLOAD
+6 ; DBIA 10040 ^SC("B")
+7 ; DBIA 10040 ^SC( file #44
+8 ; DBIA 10006 ^DIC (file #44 and 3.5)
+9 ; DBIA 10000 NOW^%DTC
+10 ;
MAIN ; Controls branching
+1 WRITE !!,"This option will queue Health Summaries for a specified Visit Date"
+2 WRITE !,"for all Outpatient Clinics with Appointments on that Visit Date.",!!
+3 NEW GMTSCDT
+4 SET GMTSCDT=$$SELDATE
if GMTSCDT'>0
QUIT
+5 WRITE !
NEW DIR
SET DIR(0)="D^::%DT"
SET DIR("A")="Date and Time to Queue this Job to run"
SET DIR("B")="NOW"
DO ^DIR
if ($DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT)))
QUIT
+6 SET ZTDTH=Y
SET ZTIO=""
SET ZTSAVE("GMTSCDT")=""
+7 SET ZTRTN="CLINICQ^GMTSPCD"
SET ZTDESC="Create Task HS Jobs for Clinics by Visit Date"
+8 DO ^%ZTLOAD
+9 QUIT
CLINICQ ; Loop thru clinics for appointments
+1 ; Date stored in GMTSCDT
+2 NEW GMTSARR,GMTSCNT,GMTSLOC,GMTSCL,GMTSTYP,GMTSJ
+3 ;GET ALL APPOINTMENTS ON DATE GMTSCDT
+4 SET GMTSARR(1)=GMTSCDT_";"_GMTSCDT
SET GMTSARR("FLDS")="1;2"
SET GMTSCNT=$$SDAPI^SDAMA301(.GMTSARR)
+5 ;IF ERROR IN SDAPI CALL, SEND MESSAGE AND QUIT
+6 IF GMTSCNT<0
DO MAIL^GMTSMAIL("SCHEDULING DATABASE ERROR "_GMTSCNT,"HS Batch Print Clinic by Date")
KILL ^TMP($JOB,"SDAMA301")
QUIT
+7 ;LOOP THROUGH RETURN ARRAY AND SORT BY CLINIC NAME REMOVING ANY CLINIC THAT IS NOT OF TYPE "C"
+8 IF GMTSCNT>0
Begin DoDot:1
+9 NEW GMTSI
SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP($JOB,"SDAMA301",GMTSI))
if 'GMTSI
QUIT
Begin DoDot:2
+10 if $PIECE($GET(^SC(GMTSI,0)),U,3)'="C"
QUIT
+11 NEW NAME,DFN,TIME,TEMP,TYPE
+12 SET DFN=$ORDER(^TMP($JOB,"SDAMA301",GMTSI,0))
+13 SET TIME=$ORDER(^TMP($JOB,"SDAMA301",GMTSI,DFN,0))
+14 SET TEMP=$PIECE(^TMP($JOB,"SDAMA301",GMTSI,DFN,TIME),U,2)
+15 SET NAME=$PIECE(TEMP,";",2)
+16 SET TYPE=0
SET TYPE=$ORDER(^GMT(142,"D",GMTSI,TYPE))
+17 IF +TYPE>0
SET ^TMP($JOB,"GMTSCL",NAME,GMTSI,TYPE)=""
End DoDot:2
End DoDot:1
+18 ;LOOP THROUGH CLINICS ALPHABETICALLY AND CALL QUEUE WITH GMTSTYP AND GMTSCL SET
+19 SET GMTSJ=""
FOR
SET GMTSJ=$ORDER(^TMP($JOB,"GMTSCL",GMTSJ))
if '$LENGTH(GMTSJ)
QUIT
SET GMTSCL=$ORDER(^TMP($JOB,"GMTSCL",GMTSJ,0))
if 'GMTSCL
QUIT
SET GMTSTYP=$ORDER(^TMP($JOB,"GMTSCL",GMTSJ,GMTSCL,0))
DO QUEUE
+20 KILL ^TMP($JOB,"GMTSCL"),^TMP($JOB,"SDAMA301")
+21 QUIT
QUEUE ; Queues HS batch print for particular HS Type and Location.
+1 NEW DIC,GMPSAP,GMTSCLI,GMTSLOC,GMTSSC,GMTSIO,GMTSDYS,GMV,QUEQIT,X,Y
+2 SET QUEQIT=0
+3 SET GMTSCLI=$ORDER(^GMT(142,GMTSTYP,20,"B",GMTSCL,0))
+4 SET GMTSLOC=$GET(^GMT(142,GMTSTYP,20,GMTSCLI,0))
+5 SET X=+GMTSLOC
SET DIC=44
SET DIC(0)="NXZ"
DO ^DIC
+6 IF $SELECT(+Y'>0:1,"WCOR"'[$PIECE($GET(Y(0)),U,3):1,1:0)
QUIT
+7 SET GMTSSC(1)=Y_U_$PIECE(Y(0),U,3)
SET $PIECE(GMTSSC(1),U,4)=GMTSCDT
+8 SET GMPSAP=$SELECT($PIECE(GMTSLOC,U,3)="Y":1,1:0)
+9 SET ZTIO=$$GETIO($PIECE(GMTSLOC,U,2))
if '$LENGTH(ZTIO)
QUIT
+10 SET ZTDTH=$HOROLOG
SET ZTRTN="MAIN^GMTSPL"
SET ZTDESC="Clinic Health Summaries by Visit Date"
+11 FOR GMV="GMTSTYP","GMPSAP"
SET ZTSAVE(GMV)=""
+12 SET ZTSAVE("GMTSSC(")=""
+13 DO ^%ZTLOAD
+14 QUIT
GETIO(X) ; Get device for queueing
+1 NEW %,%Y,C,DIC,Y
+2 SET DIC=3.5
SET DIC(0)="NXZ"
DO ^DIC
SET Y=$SELECT(+Y'>0:"",1:$PIECE(Y(0),U))
+3 QUIT Y
SELDATE() ; Allows entry of Visit/Surgery date or date range
+1 ; for Print-by-Clinic
+2 NEW %,%H,%I,DIR,DEFDT,X,Y
+3 DO NOW^%DTC
SET (X,DT)=$PIECE(%,".")
DO REGDT4^GMTSU
SET DEFDT=X
+4 SET DIR(0)="D^::EX"
SET DIR("B")=DEFDT
+5 SET DIR("A")="Please enter the Visit date"
+6 DO ^DIR
+7 IF Y="^^"
SET DIROUT=1
+8 QUIT Y
