source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENACL1.m@ 1396

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

initial load of WorldVistAEHR
File size: 5.6 KB
Line 
1DGENACL1 ;ALB/MRY - NEW ENROLLEE APPOINTMENT CALL LIST - UPDATE ;02/15/2008
2 ;;5.3;Registration;**779**;08/13/93;Build 11
3 ;
4PRINT N DGLN,PAGE,QUIT,DGTOTAL
5 S QUIT=""
6 U IO
7 I $E(IOST,1,2)="C-" D EN^DDIOL("","","@IOF")
8 S DGLN=0
9 S PAGE=1
10 D HEADER
11 D DATA
12 I DGLN=0 D
13 . D EN^DDIOL("No data to report.","","!!!?30")
14 . I $E(IOST,1,2)="C-" D PAUSE
15 I (DGLN>0),('QUIT) D SUMARY
16 Q
17 ;
18HEADER ;
19 N DG1,DG2,Y
20 I DGRPT=1 D
21 . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST CALL LIST","","!?15")
22 . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
23 . D EN^DDIOL("Page: "_PAGE,"","!?60"),EN^DDIOL("","","!!!")
24 . I ($G(DGFMT1)="S") D
25 . . D EN^DDIOL("1010EZ APPT.","","?30"),EN^DDIOL("REQ","","?45"),EN^DDIOL("RESIDENCE","","?52"),EN^DDIOL("CELLULAR","","?67")
26 . . D EN^DDIOL("NAME(SSN)"),EN^DDIOL("REQUEST DATE","","?30"),EN^DDIOL("STA","","?45"),EN^DDIOL("PHONE","","?54"),EN^DDIOL("PHONE","","?68")
27 . . D EN^DDIOL("","","!")
28 I DGRPT=2 D
29 . S Y=DGBEG D DD^%DT S DG1=Y
30 . S Y=DGEND D DD^%DT S DG2=Y
31 . D EN^DDIOL("NEW ENROLLEE APPOINTMENT REQUEST TRACKING REPORT","","!?10")
32 . S Y=DT D DD^%DT D EN^DDIOL("Date: "_Y,"","?60")
33 . D EN^DDIOL(DG1_" TO "_DG2,"","!?20"),EN^DDIOL("Page: "_PAGE,"","?60")
34 . I ($G(DGFMT2)="D") D
35 . . D EN^DDIOL("1010EZ APPT.","","!!!?37"),EN^DDIOL("SCHEDULED","","?54"),EN^DDIOL("#","","?71"),EN^DDIOL("REQ","","?76")
36 . . D EN^DDIOL("NAME"),EN^DDIOL("EP/CV","","?31"),EN^DDIOL("REQUEST DATE","","?37"),EN^DDIOL("APPOINTMENT DATE","","?51"),EN^DDIOL("DAYS","","?70"),EN^DDIOL("STA","","?76")
37 . . D EN^DDIOL("============================"),EN^DDIOL("=====","","?31"),EN^DDIOL("============","","?37"),EN^DDIOL("==================","","?51"),EN^DDIOL("====","","?70"),EN^DDIOL("===","","?76")
38 S PAGE=PAGE+1
39 Q
40DATA ;
41 N DFN,DGNAM,DGSSN,DGI,DATAEP,DGFLG,DGRDTI,DGDAYS,DFNIEN,SDADTI,SDADT,DGDAYS,DGENPRI,DGENCVEL,DATA3,DGSTA
42 F DGI="C","E","F","I","NULL" S DGTOTAL(DGI)=0
43 S DGI=0
44 F S DGI=$O(^TMP($J,"DGEN NEACL",DGI)) Q:(DGI="") D Q:QUIT
45 . S DGRDTI=0 F S DGRDTI=$O(^TMP($J,"DGEN NEACL",DGI,DGRDTI)) Q:'DGRDTI D Q:QUIT
46 .. S DGNAM="" F S DGNAM=$O(^TMP($J,"DGEN NEACL",DGI,DGRDTI,DGNAM)) Q:DGNAM="" D Q:QUIT
47 ... S DFNIEN="" F S DFNIEN=$O(^TMP($J,"DGEN NEACL",DGI,DGRDTI,DGNAM,DFNIEN)) Q:DFNIEN="" D Q:QUIT
48 .... S SDADTI=$G(^TMP($J,"DGEN NEACL",DGI,DGRDTI,DGNAM,DFNIEN))
49 .... S DGSTA=$$GET1^DIQ(2,DFNIEN,1010.161,"I") I DGSTA="" S DGSTA="NULL"
50 .... I DGSTA="C" S SDADTI=$$GET1^DIQ(2,DFNIEN,1010.162,"I")
51 .... S DGDAYS=$$DAYS(SDADTI,DGRDTI) S Y=SDADTI X ^DD("DD") S SDADT=Y
52 .... S DGFLG=0 I 'SDADTI S DGFLG=1
53 .... S DATAEP=$G(^TMP($J,"DGEN NEACL",DGI,DGRDTI,DGNAM,DFNIEN,"PRIORITY"))
54 .... S DGENPRI=$P(DATAEP,"^",3),DGENCVEL=$P(DATAEP,"^",4)
55 .... S DATA3="/" S:+DGENPRI $P(DATA3,"/")=$E(" ",$L(+DGENPRI)+1,2)_+DGENPRI S:DGENCVEL $P(DATA3,"/",2)="EL" I DATA3="/" S DATA3=""
56 .... S DGTOTAL(DGSTA)=DGTOTAL(DGSTA)+1
57 .... D ADD I '(QUIT) D LINE
58 Q
59PAUSE ;
60 N DIR,DIRUT,X,Y
61 F Q:$Y>(IOSL-3) W !
62 S DIR(0)="E"
63 D ^DIR
64 I ('(+Y))!($D(DIRUT)) S QUIT=1
65 Q
66TOP ;
67 D EN^DDIOL("","","@IOF")
68 D HEADER
69 Q
70ADD ;
71 I $E(IOST,1,2)="C-",($Y>(IOSL-3)) D
72 . D PAUSE
73 . Q:QUIT
74 . D TOP
75 I $E(IOST,1,2)'="C-",($Y>(IOSL-3)) D TOP
76 Q
77LINE ;add a line to the report
78 N DGNAMX,DPTDFN,DGCMT
79 I DGRPT=2 S DGNAMX=$P(DGNAM,",")
80 E S DGNAMX=DGNAM
81 S DGNAMX=DGNAMX_"("_$E($$GET1^DIQ(2,DFNIEN,.09),6,9)_")"
82 I DGRPT=1,($G(DGFMT1)="D") D
83 . D EN^DDIOL(DGNAMX,"","!") D ADD Q:QUIT
84 . S (Y,DPTDFN)=DFNIEN
85 . I $$TESTPAT^VADPT(+Y) D EN^DDIOL("WARNING : You have selected a test patient."),ADD Q:QUIT
86 . I $$BADADR^DGUTL3(+Y) D EN^DDIOL("WARNING : ** This patient has been flagged with a Bad Address Indicator."),ADD Q:QUIT
87 . I $D(^DPT("AXFFP",1,+Y)) D FFP^DPTLK5
88 . D ENR^DPTLK,ADD Q:QUIT
89 . D CV^DPTLK,ADD Q:QUIT
90 . D EN^DDIOL("1010EZ APPT. REQUEST DATE: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?28") D ADD Q:QUIT
91 . D EN^DDIOL("REQUEST STATUS: ") D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161),"","?28") D ADD Q:QUIT
92 . D EN^DDIOL("COMMENT: "_$$GET1^DIQ(2,DFNIEN,1010.163)) D ADD Q:QUIT
93 . D EN^DDIOL("PHONE [RESIDENCE]: "_$$GET1^DIQ(2,DFNIEN,.131))
94 . D EN^DDIOL("PHONE [CELLULAR]: "_$$GET1^DIQ(2,DFNIEN,.134),"","?44") D ADD Q:QUIT
95 . D EN^DDIOL("-------------------------------","","!?4") D ADD Q:QUIT
96 I DGRPT=1,($G(DGFMT1)="S") D Q:QUIT
97 . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
98 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?30")
99 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?46")
100 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.131),"","?51")
101 . D EN^DDIOL($$GET1^DIQ(2,DFNIEN,.134),"","?66")
102 . D ADD Q:QUIT
103 I DGRPT=2,($G(DGFMT2)="D") D
104 . D EN^DDIOL(DGNAMX) I $L(DGNAMX)>29 D EN^DDIOL("","","!") D ADD Q:QUIT
105 . D EN^DDIOL(DATA3,"","?31"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.1511),"","?37"),EN^DDIOL(SDADT,"","?51"),EN^DDIOL($J(DGDAYS,3)_$S(DGFLG:"*",1:""),"","?71"),EN^DDIOL($$GET1^DIQ(2,DFNIEN,1010.161,"I"),"","?77") D ADD Q:QUIT
106 . S DGCMT=$$GET1^DIQ(2,DFNIEN,1010.163) I $G(DGCMT)'="" D EN^DDIOL("COMMENT: "_DGCMT,"","!?3") D ADD Q:QUIT
107 S DGLN=1
108 Q
109 ;
110SUMARY ;display totals
111 K DGFMT1 S DGFMT2="S"
112 D ADD2 Q:QUIT
113 D EN^DDIOL("SUMMARY","","!!!")
114 D EN^DDIOL("==============================================================================")
115 S DGI="" F S DGI=$O(DGTOTAL(DGI)) Q:DGI="" D
116 . I (DGRPT=1)&((DGI="C")!(DGI="F")) Q
117 . D EN^DDIOL("Total number of veteran's "_$S(DGI="NULL":"",1:"with ")_$S(DGI="C":"CANCELLED",DGI="E":"EWL",DGI="F":"FILLED",DGI="I":"CONTACTED - IN PROCESS",1:"PENDING ACTION")_$S(DGI="NULL":"",1:" request status"))
118 . D EN^DDIOL($J(DGTOTAL(DGI),4),"","?73")
119 Q
120 ;
121ADD2 ;
122 I $E(IOST,1,2)="C-",($Y>(IOSL-8)) D
123 . D PAUSE
124 . Q:QUIT
125 . D TOP
126 I $E(IOST,1,2)'="C-",($Y>(IOSL-8)) D TOP
127 Q
128DAYS(X1,X2) ;Compute # of days
129 S X1=$G(X1),X2=$G(X2)
130 I X1="" S X1=DT
131 D ^%DTC
132 Q X
133Q Q
Note: See TracBrowser for help on using the repository browser.