| 1 | GMTSPCD ; SLC/DLT,KER - Queue HS Batch Print Clinic by Date ; 08/27/2002 [1/26/05 11:22am] | 
|---|
| 2 | ;;2.7;Health Summary;**28,56,70**;Oct 20, 1995;Build 5 | 
|---|
| 3 | ; | 
|---|
| 4 | ; External References | 
|---|
| 5 | ;   DBIA  10026  ^DIR | 
|---|
| 6 | ;   DBIA  10063  ^%ZTLOAD | 
|---|
| 7 | ;   DBIA  10040  ^SC("B") | 
|---|
| 8 | ;   DBIA  10040  ^SC(  file #44 | 
|---|
| 9 | ;   DBIA  10006  ^DIC  (file #44 and 3.5) | 
|---|
| 10 | ;   DBIA  10000  NOW^%DTC | 
|---|
| 11 | ; | 
|---|
| 12 | MAIN ; Controls branching | 
|---|
| 13 | W !!,"This option will queue Health Summaries for a specified Visit Date" | 
|---|
| 14 | W !,"for all Outpatient Clinics with Appointments on that Visit Date.",!! | 
|---|
| 15 | N GMTSCDT | 
|---|
| 16 | S GMTSCDT=$$SELDATE Q:GMTSCDT'>0 | 
|---|
| 17 | 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))) | 
|---|
| 18 | S ZTDTH=Y,ZTIO="",ZTSAVE("GMTSCDT")="" | 
|---|
| 19 | S ZTRTN="CLINICQ^GMTSPCD",ZTDESC="Create Task HS Jobs for Clinics by Visit Date" | 
|---|
| 20 | D ^%ZTLOAD | 
|---|
| 21 | Q | 
|---|
| 22 | CLINICQ ; Loop thru clinics for appointments | 
|---|
| 23 | ;   Date stored in GMTSCDT | 
|---|
| 24 | N GMTSARR,GMTSCNT,GMTSLOC,GMTSCL,GMTSTYP,GMTSJ | 
|---|
| 25 | ;GET ALL APPOINTMENTS ON DATE GMTSCDT | 
|---|
| 26 | S GMTSARR(1)=GMTSCDT_";"_GMTSCDT,GMTSARR("FLDS")="1;2",GMTSCNT=$$SDAPI^SDAMA301(.GMTSARR) | 
|---|
| 27 | ;IF ERROR IN SDAPI CALL, SEND MESSAGE AND QUIT | 
|---|
| 28 | I GMTSCNT<0 D MAIL^GMTSMAIL("SCHEDULING DATABASE ERROR "_GMTSCNT,"HS Batch Print Clinic by Date") K ^TMP($J,"SDAMA301") Q | 
|---|
| 29 | ;LOOP THROUGH RETURN ARRAY AND SORT BY CLINIC NAME REMOVING ANY CLINIC THAT IS NOT OF TYPE "C" | 
|---|
| 30 | I GMTSCNT>0 D | 
|---|
| 31 | .N GMTSI S GMTSI=0 F  S GMTSI=$O(^TMP($J,"SDAMA301",GMTSI)) Q:'GMTSI  D | 
|---|
| 32 | ..Q:$P($G(^SC(GMTSI,0)),U,3)'="C" | 
|---|
| 33 | ..N NAME,DFN,TIME,TEMP,TYPE | 
|---|
| 34 | ..S DFN=$O(^TMP($J,"SDAMA301",GMTSI,0)) | 
|---|
| 35 | ..S TIME=$O(^TMP($J,"SDAMA301",GMTSI,DFN,0)) | 
|---|
| 36 | ..S TEMP=$P(^TMP($J,"SDAMA301",GMTSI,DFN,TIME),U,2) | 
|---|
| 37 | ..S NAME=$P(TEMP,";",2) | 
|---|
| 38 | ..S TYPE=0,TYPE=$O(^GMT(142,"D",GMTSI,TYPE)) | 
|---|
| 39 | ..I +TYPE>0 S ^TMP($J,"GMTSCL",NAME,GMTSI,TYPE)="" | 
|---|
| 40 | ;LOOP THROUGH CLINICS ALPHABETICALLY AND CALL QUEUE WITH GMTSTYP AND GMTSCL SET | 
|---|
| 41 | 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 | 
|---|
| 42 | K ^TMP($J,"GMTSCL"),^TMP($J,"SDAMA301") | 
|---|
| 43 | Q | 
|---|
| 44 | QUEUE ; Queues HS batch print for particular HS Type and Location. | 
|---|
| 45 | N DIC,GMPSAP,GMTSCLI,GMTSLOC,GMTSSC,GMTSIO,GMTSDYS,GMV,QUEQIT,X,Y | 
|---|
| 46 | S QUEQIT=0 | 
|---|
| 47 | S GMTSCLI=$O(^GMT(142,GMTSTYP,20,"B",GMTSCL,0)) | 
|---|
| 48 | S GMTSLOC=$G(^GMT(142,GMTSTYP,20,GMTSCLI,0)) | 
|---|
| 49 | S X=+GMTSLOC,DIC=44,DIC(0)="NXZ" D ^DIC | 
|---|
| 50 | I $S(+Y'>0:1,"WCOR"'[$P($G(Y(0)),U,3):1,1:0) Q | 
|---|
| 51 | S GMTSSC(1)=Y_U_$P(Y(0),U,3),$P(GMTSSC(1),U,4)=GMTSCDT | 
|---|
| 52 | S GMPSAP=$S($P(GMTSLOC,U,3)="Y":1,1:0) | 
|---|
| 53 | S ZTIO=$$GETIO($P(GMTSLOC,U,2)) Q:'$L(ZTIO) | 
|---|
| 54 | S ZTDTH=$H,ZTRTN="MAIN^GMTSPL",ZTDESC="Clinic Health Summaries by Visit Date" | 
|---|
| 55 | F GMV="GMTSTYP","GMPSAP" S ZTSAVE(GMV)="" | 
|---|
| 56 | S ZTSAVE("GMTSSC(")="" | 
|---|
| 57 | D ^%ZTLOAD | 
|---|
| 58 | Q | 
|---|
| 59 | GETIO(X) ; Get device for queueing | 
|---|
| 60 | N %,%Y,C,DIC,Y | 
|---|
| 61 | S DIC=3.5,DIC(0)="NXZ" D ^DIC S Y=$S(+Y'>0:"",1:$P(Y(0),U)) | 
|---|
| 62 | Q Y | 
|---|
| 63 | SELDATE() ; Allows entry of Visit/Surgery date or date range | 
|---|
| 64 | ; for Print-by-Clinic | 
|---|
| 65 | N %,%H,%I,DIR,DEFDT,X,Y | 
|---|
| 66 | D NOW^%DTC S (X,DT)=$P(%,".") D REGDT4^GMTSU S DEFDT=X | 
|---|
| 67 | S DIR(0)="D^::EX",DIR("B")=DEFDT | 
|---|
| 68 | S DIR("A")="Please enter the Visit date" | 
|---|
| 69 | D ^DIR | 
|---|
| 70 | I Y="^^" S DIROUT=1 | 
|---|
| 71 | Q Y | 
|---|