DGRUASIH ; ALB/GRR - RAI/MDS ASIH BACKGROUND JOB ; 11-1-00
 ;;5.3;Registration;**328,371,373,424**;Aug 13, 1993
EN ;Main Entry Point
 ;
 Q:'$D(^DGRU(46.14,"AD","A"))  ;No patients on ASIH
 ;Look for ASIH date/times which have exceeded 30 days
 N DGASIHDT,DFN,DGIEN,DGDT,DGCDT
 D NOW^%DTC S DGCDT=% ;set to current date/time
 S DGDT=""
 F  S DGDT=$O(^DGRU(46.14,"AD","A",DGDT)) Q:DGDT=""!(DGDT>DGCDT)  D
 .S DFN=0 F  S DFN=$O(^DGRU(46.14,"AD","A",DGDT,DFN)) Q:DFN=""  D
 ..S DGIEN=$O(^DGRU(46.14,"AD","A",DGDT,DFN,0))
 ..S DGASIHDT=$P($G(^DGRU(46.14,DFN,1,DGIEN,0)),"^")
 ..S X1=DGASIHDT,X2=30 D C^%DTC S DGEVDT=X
 ..S DGPMDT=DGASIHDT-.000001 ;to get inpatient info for movement prior to asih
 ..S DGRSLT=$$BLDA03(DFN,DGEVDT,DGPMDT)
 ..D UPSTAT(DFN,DGIEN,"I")
MQUIT Q
 ;
UPSTAT(DFN,DGIEN,DGSTAT) ;
 ;DFN    - Patient internal entry number
 ;DGIEN  - Entry number in RAI MDS ASIH Patient file 
 ;DGSTAT - New status
 S DA=DGIEN,DA(1)=DFN,DR=".04///^S X=DGSTAT",(DIC,DIE)="^DGRU(46.14,"_DFN_",1," D ^DIE
 Q
 ;
BLDA03(DFN,DGEVDT,DGPMDT) ;BUILD A03 DISCHARGE MESSAGE
 S DGREF="^TMP(""HLS"","_$J_")"
 K @DGREF
 D INIT^HLFNC2("DGRU-RAI-A03-SERVER",.HL) ;changed p-371
 I ($O(HL(""))']"") S RESULT="-1^Server Protocol not found" G BLDQ
 ;
 S VAIP("D")=DGPMDT D IN5^VADPT S DGMIEN=VAIP(1)
 ;N DGTEMP
 N DGASIH S DGASIH=2 D EN^DGRUGA03(DFN,DGMIEN,"DGTEMP")
 I '$O(DGTEMP(0)) S RESULT="-1^Unable to build segment list" G BLDQ
 ;
 ;Check segment list for errors
 N I S I=0
 F  S I=$O(DGTEMP(I)) Q:'I  D  G:(+$G(RESULT)<0) BLDQ
 .I +DGTEMP(I)<0 S RESULT="-1^Error while building segment"
 ;
 M @DGREF=DGTEMP
 S RESULT=$$SENDMSG(DGREF)
 I +$P(RESULT,"^",2)>0 S RESULT="-1^"_$P(RESULT,"^",2,3)
BLDQ Q $G(RESULT)
 ;
SENDMSG(DGARRAY) ;TRANSMIT HL7 MESSAGE
 N HLA,HLRST
 M HLA("HLS")=@DGARRAY
 I $D(HLA("HLS")) D
 .D GENERATE^HLMA("DGRU-RAI-A03-SERVER","LM",1,.HLRST,"") ;changed p-371
 K HLA,HERR
 Q (HLRST)
 ;
ADDASIH(DFN,DGASIHDT) ;ADD AN ASIH FOR A PATIENT
 ;
 N DGSTAT,DIC,DR,X,DINUM S DGSTAT="A"
 I '$D(^DGRU(46.14,DFN)) D
 .S DIC="^DGRU(46.14,",DIC(0)="LN",X=DFN,DINUM=DFN D FILE^DICN
 S DA(1)=DFN,DIC="^DGRU(46.14,"_DFN_",1,",DIC(0)="L",X=DGASIHDT,DIC("DR")=".04///^S X=DGSTAT" D ^DIC
 Q
 ;
ADDRDT(DFN,DGASIHDT) ;ADD RETURN DATE FROM ASIH
 ;
 N DGSTAT,DA S DGSTAT="I"
 S DA=$O(^DGRU(46.14,"AC",DFN,"A",0)) Q:DA=""
 N DIC,DR,DIE
 S DA(1)=DFN,DIC="^DGRU(46.14,"_DFN_",1,",DIE=DIC,DR=".02///^S X=DGASIHDT;.04///^S X=DGSTAT" D ^DIE
 Q
 ;
DELASIH(DFN,DGASIHDT) ;DELETE ASIH EPISODE
 ;
 N DA,DIC,DIK
 S DA(1)=DFN,DA=$O(^DGRU(46.14,DFN,1,"B",DGASIHDT,0)) Q:DA=""
 S DIK="^DGRU(46.14,"_DFN_",1," D ^DIK
 Q
 ;
CHANGDT(DFN,DGODT,DGNDT) ;CHANGE TO ASIH DATE/TIME
 N DA,DIE,DR
 S DA(1)=DFN,DA=$O(^DGRU(46.14,DFN,1,"B",DGODT,0)) Q:DA=""
 S DIE="^DGRU(46.14,"_DFN_",1,",DR=".01///^S X=DGNDT" D ^DIE
 Q
 ;