BEDD2PST ;GDIT/HS/BEE-BEDD VERSION 2.0 POST INSTALL ROUTINE ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
;
Q
;
PST ;Post Install for BEDD Version 2.0
;
NEW BEDD,STAT,EXEC,GLB
;
;Get list of current dashboard patients
D BEDDLST^BEDDUTIL(.BEDD)
;
;Define the index global
S EXEC="S GLB=$NA(^BEDD.EDDiagnosisI(""ObjIdx""))" X EXEC
;
;Loop through the current patients and get their dx values
S STAT="" F S STAT=$O(BEDD("SUM",STAT)) Q:STAT="" D
. NEW OBJID
. S OBJID="" F S OBJID=$O(BEDD("SUM",STAT,OBJID)) Q:OBJID="" D
.. NEW SPOBJID,DXID,VSTCL,EXEC,VIEN,DECDT,NDECDT
.. ;
.. ;Open the visit class
.. S EXEC="S VSTCL=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)" X EXEC
.. ;
.. ;Get the visit IEN
.. S VIEN=""
.. S EXEC="S VIEN=VSTCL.VIEN" X EXEC
.. Q:VIEN=""
.. ;
.. ;Get the decision to admit date
.. S DECDT=""
.. S EXEC="S DECDT=VSTCL.DecAdmDt" X EXEC
.. ;
.. ;Get the decision to admit from PCC
.. S NDECDT=$$GET1^DIQ(9000010,VIEN_",",1116,"I")
.. ;
.. ;If new is blank, fill with old
.. I NDECDT="",DECDT]"" D
... NEW DECUPD,ERROR
... S DECUPD(9000010,VIEN_",",1116)=DECDT
... D FILE^DIE("","DECUPD","ERROR")
.. ;
.. ;Add space to the front
.. S SPOBJID=" "_OBJID
.. ;
.. ;Loop through the entries
.. S DXID="" F S DXID=$O(@GLB@(SPOBJID,DXID)) Q:DXID="" D
... NEW DXCL,EXEC,CDIEN,CODE,DFN,PRM,NARR,AMERPOV,AMERVERR,STS
... ;
... ;Open the diagnosis class
... S EXEC="S DXCL=##CLASS(BEDD.EDDiagnosis).%OpenId(DXID)" X EXEC
... ;
... ;Get any V POV entries - If any already on file, quit
... S AMERVERR=$$POV^AMERUTIL("",VIEN,.AMERPOV)
... I +AMERVERR Q
... ;
... ;Get the Code IEN
... S CDIEN=""
... S EXEC="S CDIEN=DXCL.CodeIEN" X EXEC
... Q:CDIEN=""
... ;
... ;Get the code
... S CODE=""
... S EXEC="S CODE=DXCL.Code" X EXEC
... Q:CODE=""
... ;
... ;Get primary/secondary
... S PRM=""
... S EXEC="S PRM=DXCL.PrimaryDiag" X EXEC
... Q:PRM=""
... ;
... ;Get the narrative
... S NARR=""
... S EXEC="S NARR=DXCL.DiagNarrative" X EXEC
... ;
... ;Get the DFN
... S DFN=""
... S EXEC="S DFN=DXCL.DFN" X EXEC
... Q:DFN=""
... ;
... ;Set up the V POV entry
... S STS=$$SAVE^BEDDPOV("",CDIEN,NARR,PRM,CODE,"NO",VIEN,DUZ,DFN)
;
Q
BEDD2PST ;GDIT/HS/BEE-BEDD VERSION 2.0 POST INSTALL ROUTINE ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
+2 ;
+3 QUIT
+4 ;
PST ;Post Install for BEDD Version 2.0
+1 ;
+2 NEW BEDD,STAT,EXEC,GLB
+3 ;
+4 ;Get list of current dashboard patients
+5 DO BEDDLST^BEDDUTIL(.BEDD)
+6 ;
+7 ;Define the index global
+8 SET EXEC="S GLB=$NA(^BEDD.EDDiagnosisI(""ObjIdx""))"
XECUTE EXEC
+9 ;
+10 ;Loop through the current patients and get their dx values
+11 SET STAT=""
FOR
SET STAT=$ORDER(BEDD("SUM",STAT))
IF STAT=""
QUIT
Begin DoDot:1
+12 NEW OBJID
+13 SET OBJID=""
FOR
SET OBJID=$ORDER(BEDD("SUM",STAT,OBJID))
IF OBJID=""
QUIT
Begin DoDot:2
+14 NEW SPOBJID,DXID,VSTCL,EXEC,VIEN,DECDT,NDECDT
+15 ;
+16 ;Open the visit class
+17 SET EXEC="S VSTCL=##CLASS(BEDD.EDVISIT).%OpenId(OBJID)"
XECUTE EXEC
+18 ;
+19 ;Get the visit IEN
+20 SET VIEN=""
+21 SET EXEC="S VIEN=VSTCL.VIEN"
XECUTE EXEC
+22 IF VIEN=""
QUIT
+23 ;
+24 ;Get the decision to admit date
+25 SET DECDT=""
+26 SET EXEC="S DECDT=VSTCL.DecAdmDt"
XECUTE EXEC
+27 ;
+28 ;Get the decision to admit from PCC
+29 SET NDECDT=$$GET1^DIQ(9000010,VIEN_",",1116,"I")
+30 ;
+31 ;If new is blank, fill with old
+32 IF NDECDT=""
IF DECDT]""
Begin DoDot:3
+33 NEW DECUPD,ERROR
+34 SET DECUPD(9000010,VIEN_",",1116)=DECDT
+35 DO FILE^DIE("","DECUPD","ERROR")
End DoDot:3
+36 ;
+37 ;Add space to the front
+38 SET SPOBJID=" "_OBJID
+39 ;
+40 ;Loop through the entries
+41 SET DXID=""
FOR
SET DXID=$ORDER(@GLB@(SPOBJID,DXID))
IF DXID=""
QUIT
Begin DoDot:3
+42 NEW DXCL,EXEC,CDIEN,CODE,DFN,PRM,NARR,AMERPOV,AMERVERR,STS
+43 ;
+44 ;Open the diagnosis class
+45 SET EXEC="S DXCL=##CLASS(BEDD.EDDiagnosis).%OpenId(DXID)"
XECUTE EXEC
+46 ;
+47 ;Get any V POV entries - If any already on file, quit
+48 SET AMERVERR=$$POV^AMERUTIL("",VIEN,.AMERPOV)
+49 IF +AMERVERR
QUIT
+50 ;
+51 ;Get the Code IEN
+52 SET CDIEN=""
+53 SET EXEC="S CDIEN=DXCL.CodeIEN"
XECUTE EXEC
+54 IF CDIEN=""
QUIT
+55 ;
+56 ;Get the code
+57 SET CODE=""
+58 SET EXEC="S CODE=DXCL.Code"
XECUTE EXEC
+59 IF CODE=""
QUIT
+60 ;
+61 ;Get primary/secondary
+62 SET PRM=""
+63 SET EXEC="S PRM=DXCL.PrimaryDiag"
XECUTE EXEC
+64 IF PRM=""
QUIT
+65 ;
+66 ;Get the narrative
+67 SET NARR=""
+68 SET EXEC="S NARR=DXCL.DiagNarrative"
XECUTE EXEC
+69 ;
+70 ;Get the DFN
+71 SET DFN=""
+72 SET EXEC="S DFN=DXCL.DFN"
XECUTE EXEC
+73 IF DFN=""
QUIT
+74 ;
+75 ;Set up the V POV entry
+76 SET STS=$$SAVE^BEDDPOV("",CDIEN,NARR,PRM,CODE,"NO",VIEN,DUZ,DFN)
End DoDot:3
End DoDot:2
End DoDot:1
+77 ;
+78 QUIT