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

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1DG53213P ;BP-CIOFO/KEITH - NPCDB patient demographics extraction utility ; 07 Dec 98 12:05 PM
2 ;;5.3;Registration;**213**;AUG 13, 1993
3 ;
4NOQ ;Suppress option question
5 S:$G(XPDENV)=1 XPDDIQ("XPZ1")=0 Q
6 ;
7RUN ;Exit if XTMP global exists
8 N X F X=1:1:10 L ^XTMP("DG53213P",0):1 Q:$T
9 I '$T D BMES^XPDUTL("Unable to lock global try later!") Q
10 I $D(^XTMP("DG53213P",0)),$$ZQ() G LQ
11 ;
12BQ ;Queue extraction global build process
13 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,DGI,Y,%,%H,%I
14 S ZTRTN="BUILD^DG53213P",ZTDESC="NPCDB patient demographics extraction"
15 D NOW^%DTC S (DGQDT,ZTDTH)=XPDQUES("POS1"),ZTIO=""
16 F DGI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
17 I '$G(ZTSK) D BMES^XPDUTL("Unable to queue extraction, contact Customer Service for assistance!") G LQ
18 S Y=DGQDT X ^DD("DD")
19 N X1,X2,DGPDT K ^XTMP("DG53213P")
20 S X1=DT,X2=30 D C^%DTC S DGPDT=X
21 S ^XTMP("DG53213P",0)=DGPDT_U_DT_"^Patch DG*5.3*213 NPCDB patient demographics extraction global. Created by user: "_DUZ
22 S ^XTMP("DG53213P",1,"QUEUED")=DGQDT_U_ZTSK
23 D BMES^XPDUTL("NPCDB patient demographics extraction queued for "_$P(Y,":",1,2))
24 D BMES^XPDUTL("Task number: "_ZTSK)
25LQ L -^XTMP("DG53213P")
26 Q
27 ;
28ZQ() ;Determine if process is already queued
29 N ZTSK S ZTSK=+$P($G(^XTMP("DG53213P",1,"QUEUED")),U,2) Q:'ZTSK 0
30 D STAT^%ZTLOAD Q:'ZTSK(0) 0 Q:"0345"[ZTSK(1) 0
31 D BMES^XPDUTL("Patient demographics extraction not queued--")
32 D BMES^XPDUTL("It appears that this process is already in progress!")
33 Q 1
34 ;
35BUILD ;Build XTMP global with list of records to send
36 S (DGFS,DGOUT)=0 F DGI="COUNT","SENT" S ^XTMP("DG53213P",1,DGI)=0
37 ;
38 ;Get patient list
39 S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN!DGOUT D
40 .I DFN#500=0 D STOP Q:DGOUT
41 .I $L($P($G(^DPT(DFN,.1)),U)) D SET("CI") Q ;Current inpatient
42 .I $O(^DGPM("APTT3",DFN,""),-1)>2981001 D SET("DC") Q ;Discharged this Fiscal Year
43 .I $$OUTPTPR^SDUTL3(DFN) D SET("PC") Q ;Assigned to PC provider
44 .Q
45 ;
46 I DGOUT S DGFS=1 K ^XTMP("DG53213P",2) D REQUE("BUILD^DG53213P"),MSG Q
47 ;
48 S ^XTMP("DG53213P",1,"GROUP")=^XTMP("DG53213P",1,"COUNT")\7+1
49 ;
50SEND ;Send group of patient records to NPCDB
51 S (DGOUT,DGFS)=0,DGGP=^XTMP("DG53213P",1,"GROUP")
52 S (DGCT,DGERR,DFN)=0
53 F S DFN=$O(^XTMP("DG53213P",2,DFN)) Q:DGCT>DGGP!'DFN!DGOUT D S1
54 I 'DGOUT,DGCT<DGGP,$D(^XTMP("DG53213P",2)) G SEND
55 S ^XTMP("DG53213P",1,"SENT")=^XTMP("DG53213P",1,"SENT")+DGCT
56 I $$DONE() D MSG K ^XTMP("DG53213P") Q
57 D REQUE("SEND^DG53213P"),MSG Q
58 ;
59REQUE(ZTRTN) ;Requeue for tomorrow's run
60 ;Required input: ZTRTN=routine to queue
61 N ZTDESC,ZTIO,X,Y,%,%H,%I,X1,X2,X
62 S %H=ZTDTH D YX^%DTC S ZTDTH=X_%
63 S ZTDESC="NPCDB patient demographics extraction"
64 S X1=ZTDTH,X2=1 D C^%DTC S (DGQDT,ZTDTH)=X,ZTIO=""
65 F DGI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
66 I $G(ZTSK) S ^XTMP("DG53213P",1,"QUEUED")=DGQDT_U_ZTSK
67 S:'$G(ZTSK) DGERR=1
68 Q
69 ;
70MSG ;Send mail message
71 N XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ,DG,DA,DIE,DR
72BMSG S XMSUB="NPCDB patient demographics extraction",DGERR=$G(DGERR,0)
73 S (XMDUZ,XMDUN)="Patch DG*5.3*213"
74 D M1 S XMTEXT="DG(",XMY(DUZ)="" D ^XMD
75 ;
76CLEAN K DGFS,DGOUT,DGQDT,DGERR,DGI,DFN,DGCT,DGGP,DGPV Q
77 ;
78M1 ;Message text
79 S DGI=0 I '$$DONE() S Y=DGQDT X ^DD("DD")
80 D TXT(" *** Status of NPCDB patient demographics extraction ***"),TXT(" ")
81 I $$DONE(),'DGFS D TXT(" NPCDB patient demographics extraction completed!"),TXT(" ")
82 I DGERR D TXT("Unable to queue NPCDB patient demographics extraction continuation--"),TXT("Please contact Customer Service for assistance!"),TXT(" ")
83 D:'DGFS TXT(" Number of records found to send: "_^XTMP("DG53213P",1,"COUNT"))
84 D:'DGFS TXT("Number of records that have been sent: "_^XTMP("DG53213P",1,"SENT"))
85 D:DGFS TXT("Extraction process was requested to stop before building a complete list.")
86 D:DGFS TXT("The partially built list was cleared, extraction will be restarted as follows:")
87 D TXT(" ")
88 I '$$DONE()!DGFS,'DGERR D
89 .D:DGFS TXT(" NPCDB extraction queued for: "_Y)
90 .D:'DGFS TXT(" Next transmission queued for: "_Y)
91 .D TXT(" Task number: "_ZTSK)
92 .Q
93 I $$DONE(),$D(^XTMP("DG53213P",4)) D
94 .D TXT("Unable to send these records:")
95 .S DFN=0 F S DFN=$O(^XTMP("DG53213P",4)) Q:'DFN D
96 ..D TXT("IFN: "_DFN_" NAME: "_$P($G(^DPT(DFN,0),"UNKNOWN"),U))
97 ..Q
98 .Q
99 Q
100 ;
101TXT(DGT) ;Build message line
102 ;Required input: DGT=line of text
103 S DGI=DGI+1,DG(DGI)=DGT Q
104 ;
105DONE() ;Determine if extraction is finished
106 Q '$D(^XTMP("DG53213P",2))
107 ;
108S1 ;Send a record
109 I DGCT#100=0 D STOP Q:DGOUT
110 S DGPV=$$PIVNW^VAFHPIVT(DFN,$$NOW^XLFDT(),4,DFN_";DPT(")
111 I 'DGPV D Q
112 .S ^XTMP("DG53213P",2,DFN)=^XTMP("DG53213P",2,DFN)+1
113 .Q:^XTMP("DG53213P",2,DFN)<3
114 .S ^XTMP("DG53213P",4,DFN)=""
115 .K ^XTMP("DG53213P",2,DFN) Q
116 D XMITFLAG^VAFCDD01(,DGPV)
117 S ^XTMP("DG53213P",3,DFN)=DGPV,DGCT=DGCT+1
118 K ^XTMP("DG53213P",2,DFN)
119 Q
120 ;
121SET(DGR) ;Set patient list node
122 ;Required input: DGR=reason for inclusion
123 S ^XTMP("DG53213P",2,DFN)=DGR
124 S ^XTMP("DG53213P",1,"COUNT")=^XTMP("DG53213P",1,"COUNT")+1
125 Q
126 ;
127STOP ;Check for stop task request
128 S:$D(ZTQUEUED) (DGOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
Note: See TracBrowser for help on using the repository browser.