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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1DGRUASIH ; ALB/GRR - RAI/MDS ASIH BACKGROUND JOB ; 11-1-00
2 ;;5.3;Registration;**328,371,373,424**;Aug 13, 1993
3EN ;Main Entry Point
4 ;
5 Q:'$D(^DGRU(46.14,"AD","A")) ;No patients on ASIH
6 ;Look for ASIH date/times which have exceeded 30 days
7 N DGASIHDT,DFN,DGIEN,DGDT,DGCDT
8 D NOW^%DTC S DGCDT=% ;set to current date/time
9 S DGDT=""
10 F S DGDT=$O(^DGRU(46.14,"AD","A",DGDT)) Q:DGDT=""!(DGDT>DGCDT) D
11 .S DFN=0 F S DFN=$O(^DGRU(46.14,"AD","A",DGDT,DFN)) Q:DFN="" D
12 ..S DGIEN=$O(^DGRU(46.14,"AD","A",DGDT,DFN,0))
13 ..S DGASIHDT=$P($G(^DGRU(46.14,DFN,1,DGIEN,0)),"^")
14 ..S X1=DGASIHDT,X2=30 D C^%DTC S DGEVDT=X
15 ..S DGPMDT=DGASIHDT-.000001 ;to get inpatient info for movement prior to asih
16 ..S DGRSLT=$$BLDA03(DFN,DGEVDT,DGPMDT)
17 ..D UPSTAT(DFN,DGIEN,"I")
18MQUIT Q
19 ;
20UPSTAT(DFN,DGIEN,DGSTAT) ;
21 ;DFN - Patient internal entry number
22 ;DGIEN - Entry number in RAI MDS ASIH Patient file
23 ;DGSTAT - New status
24 S DA=DGIEN,DA(1)=DFN,DR=".04///^S X=DGSTAT",(DIC,DIE)="^DGRU(46.14,"_DFN_",1," D ^DIE
25 Q
26 ;
27BLDA03(DFN,DGEVDT,DGPMDT) ;BUILD A03 DISCHARGE MESSAGE
28 S DGREF="^TMP(""HLS"","_$J_")"
29 K @DGREF
30 D INIT^HLFNC2("DGRU-RAI-A03-SERVER",.HL) ;changed p-371
31 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ
32 ;
33 S VAIP("D")=DGPMDT D IN5^VADPT S DGMIEN=VAIP(1)
34 ;N DGTEMP
35 N DGASIH S DGASIH=2 D EN^DGRUGA03(DFN,DGMIEN,"DGTEMP")
36 I '$O(DGTEMP(0)) S RESULT="-1^Unable to build segment list" G BLDQ
37 ;
38 ;Check segment list for errors
39 N I S I=0
40 F S I=$O(DGTEMP(I)) Q:'I D G:(+$G(RESULT)<0) BLDQ
41 .I +DGTEMP(I)<0 S RESULT="-1^Error while building segment"
42 ;
43 M @DGREF=DGTEMP
44 S RESULT=$$SENDMSG(DGREF)
45 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3)
46BLDQ Q $G(RESULT)
47 ;
48SENDMSG(DGARRAY) ;TRANSMIT HL7 MESSAGE
49 N HLA,HLRST
50 M HLA("HLS")=@DGARRAY
51 I $D(HLA("HLS")) D
52 .D GENERATE^HLMA("DGRU-RAI-A03-SERVER","LM",1,.HLRST,"") ;changed p-371
53 K HLA,HERR
54 Q (HLRST)
55 ;
56ADDASIH(DFN,DGASIHDT) ;ADD AN ASIH FOR A PATIENT
57 ;
58 N DGSTAT,DIC,DR,X,DINUM S DGSTAT="A"
59 I '$D(^DGRU(46.14,DFN)) D
60 .S DIC="^DGRU(46.14,",DIC(0)="LN",X=DFN,DINUM=DFN D FILE^DICN
61 S DA(1)=DFN,DIC="^DGRU(46.14,"_DFN_",1,",DIC(0)="L",X=DGASIHDT,DIC("DR")=".04///^S X=DGSTAT" D ^DIC
62 Q
63 ;
64ADDRDT(DFN,DGASIHDT) ;ADD RETURN DATE FROM ASIH
65 ;
66 N DGSTAT,DA S DGSTAT="I"
67 S DA=$O(^DGRU(46.14,"AC",DFN,"A",0)) Q:DA=""
68 N DIC,DR,DIE
69 S DA(1)=DFN,DIC="^DGRU(46.14,"_DFN_",1,",DIE=DIC,DR=".02///^S X=DGASIHDT;.04///^S X=DGSTAT" D ^DIE
70 Q
71 ;
72DELASIH(DFN,DGASIHDT) ;DELETE ASIH EPISODE
73 ;
74 N DA,DIC,DIK
75 S DA(1)=DFN,DA=$O(^DGRU(46.14,DFN,1,"B",DGASIHDT,0)) Q:DA=""
76 S DIK="^DGRU(46.14,"_DFN_",1," D ^DIK
77 Q
78 ;
79CHANGDT(DFN,DGODT,DGNDT) ;CHANGE TO ASIH DATE/TIME
80 N DA,DIE,DR
81 S DA(1)=DFN,DA=$O(^DGRU(46.14,DFN,1,"B",DGODT,0)) Q:DA=""
82 S DIE="^DGRU(46.14,"_DFN_",1,",DR=".01///^S X=DGNDT" D ^DIE
83 Q
84 ;
Note: See TracBrowser for help on using the repository browser.