Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRUASIH

DGRUASIH.m

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