source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPCD.m@ 1080

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMTSPCD ; 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 ;
12MAIN ; 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
22CLINICQ ; 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
44QUEUE ; 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
59GETIO(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
63SELDATE() ; 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
Note: See TracBrowser for help on using the repository browser.