BJPNFAUD ;GDIT/HS/BEE-Prenatal Care Module - Retrieve Audit History ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
;
Q
;
ACOMP(RET,PIPIEN,PRBIEN) ;Retrieve audit history for a PIP entry
;
;Input validation
I $G(PIPIEN)="" Q
I $G(PRBIEN)="" Q
;
NEW FILE,AIEN,SBPIP,PIEN,SBPRB,FNUM,IEN2,XOLD,DFN
;
;Get the DFN
S DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
;
;Loop through PIP file audits first
S FILE=90680.01
S AIEN="" F S AIEN=$O(^DIA(FILE,"B",PIPIEN,AIEN)) Q:AIEN="" D
. NEW ADT,ND,AUSR,XFLD,XOLD,XNEW,FLD,DFILE
. ;
. ;Pull the top node
. S ND=$G(^DIA(FILE,AIEN,0))
. ;
. ;Get the date/time of change
. S ADT=$P(ND,U,2) S:ADT="" ADT=" "
. S ADT=$$TMIN(ADT)
. ;
. ;Get change user
. S AUSR=$P(ND,U,4) S:AUSR="" AUSR=" "
. ;
. ;Get field changed
. S FLD=$P(ND,U,3) Q:FLD=""
. ;
. ;Get the field name
. S DFILE=FILE
. I FLD["," D
.. NEW SFLD,SFILE,SBFLD
.. S SFLD=$P(FLD,",") Q:SFLD=""
.. S SBFLD=$P(FLD,",",2) Q:SBFLD=""
.. S SFILE=+$P($G(^DD(FILE,SFLD,0)),U,2) Q:SFLD=""
.. S FLD=SBFLD
.. S DFILE=SFILE
. S XFLD=$P($G(^DD(DFILE,FLD,0)),U) Q:XFLD=""
. ;
. ;Get old value
. S XOLD=$P($G(^DIA(FILE,AIEN,2)),U)
. ;
. ;Get new value
. S XNEW=$P($G(^DIA(FILE,AIEN,3)),U)
. ;
. ;Set up sortable entry
. S @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$P(ND,U)
;
;Now loop through PIP file subentries
S FILE=90680.01,SBPIP=PIPIEN_","
S PIEN=SBPIP F S PIEN=$O(^DIA(FILE,"B",PIEN)) Q:PIEN="" Q:PIEN'[SBPIP D
. S AIEN="" F S AIEN=$O(^DIA(FILE,"B",PIEN,AIEN)) Q:AIEN="" D
.. NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
.. ;
.. ;Pull the top node
.. S ND=$G(^DIA(FILE,AIEN,0))
.. ;
.. ;Get the date/time of change
.. S ADT=$P(ND,U,2) S:ADT="" ADT=" "
.. S ADT=$$TMIN(ADT)
.. ;
.. ;Get change user
.. S AUSR=$P(ND,U,4) S:AUSR="" AUSR=" "
.. ;
.. ;Get field changed
.. S FLD=$P(ND,U,3) Q:FLD=""
.. ;
.. ;Get the field name
.. S DFILE=FILE
.. I FLD["," D
... NEW SFLD,SFILE,SBFLD
... S SFLD=$P(FLD,",") Q:SFLD=""
... S SBFLD=$P(FLD,",",2) Q:SBFLD=""
... S SFILE=+$P($G(^DD(FILE,SFLD,0)),U,2) Q:SFLD=""
... S FLD=SBFLD
... S DFILE=SFILE
.. S XFLD=$P($G(^DD(DFILE,FLD,0)),U) Q:XFLD=""
.. S:XFLD="PIP" XFLD="PIPF"
.. ;
.. ;Get old value
.. S XOLD=$P($G(^DIA(FILE,AIEN,2)),U)
.. ;
.. ;Get new value
.. S XNEW=$P($G(^DIA(FILE,AIEN,3)),U)
.. ;
.. ;Set up sortable entry
.. S @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$P(ND,U)
;
;Now loop through the PROBLEM file
S FILE=9000011
S AIEN="" F S AIEN=$O(^DIA(FILE,"B",PRBIEN,AIEN)) Q:AIEN="" D
. NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
. ;
. ;Pull the top node
. S ND=$G(^DIA(FILE,AIEN,0))
. ;
. ;Get the date/time of change
. S ADT=$P(ND,U,2) S:ADT="" ADT=" "
. S ADT=$$TMIN(ADT)
. ;
. ;Get change user
. S AUSR=$P(ND,U,4) S:AUSR="" AUSR=" "
. ;
. ;Get field changed
. S FLD=$P(ND,U,3) Q:FLD=""
. ;
. ;Get the field name
. S DFILE=FILE
. I FLD["," D
.. NEW SFLD,SFILE,SBFLD
.. S SFLD=$P(FLD,",") Q:SFLD=""
.. S SBFLD=$P(FLD,",",2) Q:SBFLD=""
.. S SFILE=+$P($G(^DD(FILE,SFLD,0)),U,2) Q:SFLD=""
.. S FLD=SBFLD
.. S DFILE=SFILE
. S XFLD=$P($G(^DD(DFILE,FLD,0)),U) Q:XFLD=""
. ;
. ;Get old value
. S XOLD=$P($G(^DIA(FILE,AIEN,2)),U)
. ;
. ;Get new value
. S XNEW=$P($G(^DIA(FILE,AIEN,3)),U)
. ;
. ;Set up sortable entry
. S @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$P(ND,U)
;
;Now loop through PROBLEM file subentries
S FILE=9000011,SBPRB=PRBIEN_","
S PIEN=SBPRB F S PIEN=$O(^DIA(FILE,"B",PIEN)) Q:PIEN="" D Q:PIEN'[SBPRB
. S AIEN="" F S AIEN=$O(^DIA(FILE,"B",PIEN,AIEN)) Q:AIEN="" D
.. NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
.. ;
.. ;Pull the top node
.. S ND=$G(^DIA(FILE,AIEN,0))
.. ;
.. ;Get the date/time of change
.. S ADT=$P(ND,U,2) S:ADT="" ADT=" "
.. S ADT=$$TMIN(ADT)
.. ;
.. ;Get change user
.. S AUSR=$P(ND,U,4) S:AUSR="" AUSR=" "
.. ;
.. ;Get field changed
.. S FLD=$P(ND,U,3) Q:FLD=""
.. ;
.. ;Get the field name
.. S DFILE=FILE
.. I FLD["," D
... NEW SFLD,SFILE,SBFLD
... S SFLD=$P(FLD,",") Q:SFLD=""
... S SBFLD=$P(FLD,",",2) Q:SBFLD=""
... S SFILE=+$P($G(^DD(FILE,SFLD,0)),U,2) Q:SFLD=""
... S FLD=SBFLD
... S DFILE=SFILE
.. S XFLD=$P($G(^DD(DFILE,FLD,0)),U) Q:XFLD=""
.. ;
.. ;Get old value
.. S XOLD=$P($G(^DIA(FILE,AIEN,2)),U)
.. ;
.. ;Get new value
.. S XNEW=$P($G(^DIA(FILE,AIEN,3)),U)
.. ;
.. ;Set up sortable entry
.. S @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$P(ND,U)
;
;Add in qualifiers - EDITS/DELETES are also getting pulled from DIA
;Since the DIA field is EDIT/DELETE only, attempt to grab an add
S FNUM=9000011.13,XOLD=""
S IEN2=0 F S IEN2=$O(^AUPNPROB(PRBIEN,13,IEN2)) Q:'+IEN2 D
. NEW AIEN,Q,BY,WHEN,XNEW
. S AIEN=IEN2_","_PRBIEN_","
. S XNEW=$$GET1^DIQ(FNUM,AIEN,.01)
. Q:XNEW=246112005 ;Skip the attribute entry
. S BY=$$GET1^DIQ(FNUM,AIEN,.02,"I") S:BY="" BY=" "
. S WHEN=$$TMIN($$GET1^DIQ(FNUM,AIEN,.03,"I")) S:WHEN="" WHEN=" "
. S @RET@(WHEN,BY,"SEVERITY")=XOLD_U_XNEW_U_PRBIEN_","_IEN2
. S XOLD=XNEW
;
;Get the Care Plans
D
. NEW CDATA
. D GET^BGOCPLAN(.CDATA,PRBIEN,DFN,"C","C","")
. D PLAN
;
;Get the Goals
D
. NEW CDATA
. D GET^BGOCPLAN(.CDATA,PRBIEN,DFN,"G","C","")
. D PLAN
;
;Get the Visit Instructions
D
. NEW VDATA,VIEN
. D GET^BGOVVI(.VDATA,DFN,PRBIEN,99999,"",.VIEN)
. Q:'$D(^TMP("BGOVIN",$J))
. D VISIT
;
;Get the V Treatment Regimen
D
. NEW TDATA,VIEN
. D GET^BGOVTR(.TDATA,DFN,PRBIEN,99999,"",.VIEN)
. Q:'$D(^TMP("BGOVIN",$J))
. D TREAT
;
;Get the Patient Education
D
. NEW EDATA,VIEN
. D GETEDU^BGOVTR(.EDATA,DFN,PRBIEN,99999,.VIEN)
. Q:'$D(^TMP("BGOVIN",$J))
. D EDU
;
TMIN(TIME) ;Drop any seconds off the time
Q +($P(TIME,".")_"."_$E($P(TIME,".",2),1,4))
;
PLAN ;GET ALL CARE PLANNING DATA
NEW CT2
S CT2=0
F S CT2=$O(^TMP("BGOPLAN",$J,CT2)) Q:'+CT2 D
. NEW STR,TYPE,IEN,STS
. ;
. S STR=$G(^TMP("BGOPLAN",$J,CT2))
. Q:$P(STR,U,1)="~t"
. ;
. ;Get the IEN
. S TYPE=$P(STR,U)
. S IEN=$P(STR,U,2) Q:IEN=""
. ;
. ;Now loop through the history
. S STS=0 F S STS=$O(^AUPNCPL(IEN,11,STS)) Q:'STS D
.. NEW DA,IENS,ADT,USR,XSTS
.. S DA(1)=IEN,DA=STS,IENS=$$IENS^DILF(.DA)
.. S ADT=$$GET1^DIQ(9000092.11,IENS,.03,"I") S:ADT="" ADT=" "
.. S ADT=$$TMIN(ADT)
.. S USR=$$GET1^DIQ(9000092.11,IENS,.02,"I") S:USR="" USR=" "
.. S XSTS=$$GET1^DIQ(9000092.11,IENS,.01,"E")
.. S @RET@(ADT,USR,$S(TYPE="G":"GOAL.",1:"CARE.")_IEN)=XSTS
. Q
Q
;
VISIT ;GET ALL VISIT INSTRUCTION DATA
NEW CT2
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
. NEW STR,IEN
. ;
. S STR=$G(^TMP("BGOVIN",$J,CT2))
. Q:$P(STR,U,1)="~t"
. ;
. ;Get the IEN
. S IEN=$P(STR,U,2) Q:IEN=""
. ;
. ;Get entered date/time
. S ADT=$$TMIN($$GET1^DIQ(9000010.58,IEN_",",1216,"I")) S:ADT="" ADT=" "
. ;
. ;Get entered by
. S USR=$$GET1^DIQ(9000010.58,IEN_",",1217,"I") S:USR="" USR=" "
. ;
. ;Set up entry
. S @RET@(ADT,USR,"VINS."_IEN)=""
. Q
Q
;
TREAT ;GET ALL TREATMENT REGIMEN DATA
NEW CT2
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
. NEW STR,IEN
. ;
. S STR=$G(^TMP("BGOVIN",$J,CT2))
. ;
. ;Get the IEN
. S IEN=$P(STR,U,2) Q:IEN=""
. ;
. ;Get entered date/time
. S ADT=$$TMIN($$GET1^DIQ(9000010.61,IEN_",",1216,"I")) S:ADT="" ADT=" "
. ;
. ;Get entered by
. S USR=$$GET1^DIQ(9000010.61,IEN_",",1217,"I") S:USR="" USR=" "
. ;
. ;Set up entry
. S @RET@(ADT,USR,"VTR."_IEN)=""
. Q
Q
;
EDU ;GET ALL EDUCATION DATA
NEW CT2
S CT2=0
F S CT2=$O(^TMP("BGOVIN",$J,CT2)) Q:'+CT2 D
. NEW STR,IEN
. ;
. S STR=$G(^TMP("BGOVIN",$J,CT2))
. ;
. ;Get the IEN
. S IEN=$P(STR,U,6) Q:IEN=""
. ;
. ;Get entered date/time
. S ADT=$$TMIN($$GET1^DIQ(9000010.16,IEN_",",1216,"I")) S:ADT="" ADT=" "
. ;
. ;Get entered by
. S USR=$$GET1^DIQ(9000010.16,IEN_",",1217,"I") S:USR="" USR=" "
. ;
. ;Set up entry
. S @RET@(ADT,USR,"VEDU."_IEN)=""
. Q
Q
BJPNFAUD ;GDIT/HS/BEE-Prenatal Care Module - Retrieve Audit History ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
+2 ;
+3 QUIT
+4 ;
ACOMP(RET,PIPIEN,PRBIEN) ;Retrieve audit history for a PIP entry
+1 ;
+2 ;Input validation
+3 IF $GET(PIPIEN)=""
QUIT
+4 IF $GET(PRBIEN)=""
QUIT
+5 ;
+6 NEW FILE,AIEN,SBPIP,PIEN,SBPRB,FNUM,IEN2,XOLD,DFN
+7 ;
+8 ;Get the DFN
+9 SET DFN=$$GET1^DIQ(9000011,PRBIEN_",",.02,"I")
+10 ;
+11 ;Loop through PIP file audits first
+12 SET FILE=90680.01
+13 SET AIEN=""
FOR
SET AIEN=$ORDER(^DIA(FILE,"B",PIPIEN,AIEN))
IF AIEN=""
QUIT
Begin DoDot:1
+14 NEW ADT,ND,AUSR,XFLD,XOLD,XNEW,FLD,DFILE
+15 ;
+16 ;Pull the top node
+17 SET ND=$GET(^DIA(FILE,AIEN,0))
+18 ;
+19 ;Get the date/time of change
+20 SET ADT=$PIECE(ND,U,2)
IF ADT=""
SET ADT=" "
+21 SET ADT=$$TMIN(ADT)
+22 ;
+23 ;Get change user
+24 SET AUSR=$PIECE(ND,U,4)
IF AUSR=""
SET AUSR=" "
+25 ;
+26 ;Get field changed
+27 SET FLD=$PIECE(ND,U,3)
IF FLD=""
QUIT
+28 ;
+29 ;Get the field name
+30 SET DFILE=FILE
+31 IF FLD[","
Begin DoDot:2
+32 NEW SFLD,SFILE,SBFLD
+33 SET SFLD=$PIECE(FLD,",")
IF SFLD=""
QUIT
+34 SET SBFLD=$PIECE(FLD,",",2)
IF SBFLD=""
QUIT
+35 SET SFILE=+$PIECE($GET(^DD(FILE,SFLD,0)),U,2)
IF SFLD=""
QUIT
+36 SET FLD=SBFLD
+37 SET DFILE=SFILE
End DoDot:2
+38 SET XFLD=$PIECE($GET(^DD(DFILE,FLD,0)),U)
IF XFLD=""
QUIT
+39 ;
+40 ;Get old value
+41 SET XOLD=$PIECE($GET(^DIA(FILE,AIEN,2)),U)
+42 ;
+43 ;Get new value
+44 SET XNEW=$PIECE($GET(^DIA(FILE,AIEN,3)),U)
+45 ;
+46 ;Set up sortable entry
+47 SET @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$PIECE(ND,U)
End DoDot:1
+48 ;
+49 ;Now loop through PIP file subentries
+50 SET FILE=90680.01
SET SBPIP=PIPIEN_","
+51 SET PIEN=SBPIP
FOR
SET PIEN=$ORDER(^DIA(FILE,"B",PIEN))
IF PIEN=""
QUIT
IF PIEN'[SBPIP
QUIT
Begin DoDot:1
+52 SET AIEN=""
FOR
SET AIEN=$ORDER(^DIA(FILE,"B",PIEN,AIEN))
IF AIEN=""
QUIT
Begin DoDot:2
+53 NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
+54 ;
+55 ;Pull the top node
+56 SET ND=$GET(^DIA(FILE,AIEN,0))
+57 ;
+58 ;Get the date/time of change
+59 SET ADT=$PIECE(ND,U,2)
IF ADT=""
SET ADT=" "
+60 SET ADT=$$TMIN(ADT)
+61 ;
+62 ;Get change user
+63 SET AUSR=$PIECE(ND,U,4)
IF AUSR=""
SET AUSR=" "
+64 ;
+65 ;Get field changed
+66 SET FLD=$PIECE(ND,U,3)
IF FLD=""
QUIT
+67 ;
+68 ;Get the field name
+69 SET DFILE=FILE
+70 IF FLD[","
Begin DoDot:3
+71 NEW SFLD,SFILE,SBFLD
+72 SET SFLD=$PIECE(FLD,",")
IF SFLD=""
QUIT
+73 SET SBFLD=$PIECE(FLD,",",2)
IF SBFLD=""
QUIT
+74 SET SFILE=+$PIECE($GET(^DD(FILE,SFLD,0)),U,2)
IF SFLD=""
QUIT
+75 SET FLD=SBFLD
+76 SET DFILE=SFILE
End DoDot:3
+77 SET XFLD=$PIECE($GET(^DD(DFILE,FLD,0)),U)
IF XFLD=""
QUIT
+78 IF XFLD="PIP"
SET XFLD="PIPF"
+79 ;
+80 ;Get old value
+81 SET XOLD=$PIECE($GET(^DIA(FILE,AIEN,2)),U)
+82 ;
+83 ;Get new value
+84 SET XNEW=$PIECE($GET(^DIA(FILE,AIEN,3)),U)
+85 ;
+86 ;Set up sortable entry
+87 SET @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$PIECE(ND,U)
End DoDot:2
End DoDot:1
+88 ;
+89 ;Now loop through the PROBLEM file
+90 SET FILE=9000011
+91 SET AIEN=""
FOR
SET AIEN=$ORDER(^DIA(FILE,"B",PRBIEN,AIEN))
IF AIEN=""
QUIT
Begin DoDot:1
+92 NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
+93 ;
+94 ;Pull the top node
+95 SET ND=$GET(^DIA(FILE,AIEN,0))
+96 ;
+97 ;Get the date/time of change
+98 SET ADT=$PIECE(ND,U,2)
IF ADT=""
SET ADT=" "
+99 SET ADT=$$TMIN(ADT)
+100 ;
+101 ;Get change user
+102 SET AUSR=$PIECE(ND,U,4)
IF AUSR=""
SET AUSR=" "
+103 ;
+104 ;Get field changed
+105 SET FLD=$PIECE(ND,U,3)
IF FLD=""
QUIT
+106 ;
+107 ;Get the field name
+108 SET DFILE=FILE
+109 IF FLD[","
Begin DoDot:2
+110 NEW SFLD,SFILE,SBFLD
+111 SET SFLD=$PIECE(FLD,",")
IF SFLD=""
QUIT
+112 SET SBFLD=$PIECE(FLD,",",2)
IF SBFLD=""
QUIT
+113 SET SFILE=+$PIECE($GET(^DD(FILE,SFLD,0)),U,2)
IF SFLD=""
QUIT
+114 SET FLD=SBFLD
+115 SET DFILE=SFILE
End DoDot:2
+116 SET XFLD=$PIECE($GET(^DD(DFILE,FLD,0)),U)
IF XFLD=""
QUIT
+117 ;
+118 ;Get old value
+119 SET XOLD=$PIECE($GET(^DIA(FILE,AIEN,2)),U)
+120 ;
+121 ;Get new value
+122 SET XNEW=$PIECE($GET(^DIA(FILE,AIEN,3)),U)
+123 ;
+124 ;Set up sortable entry
+125 SET @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$PIECE(ND,U)
End DoDot:1
+126 ;
+127 ;Now loop through PROBLEM file subentries
+128 SET FILE=9000011
SET SBPRB=PRBIEN_","
+129 SET PIEN=SBPRB
FOR
SET PIEN=$ORDER(^DIA(FILE,"B",PIEN))
IF PIEN=""
QUIT
Begin DoDot:1
+130 SET AIEN=""
FOR
SET AIEN=$ORDER(^DIA(FILE,"B",PIEN,AIEN))
IF AIEN=""
QUIT
Begin DoDot:2
+131 NEW ADT,ND,AUSR,XFLD,XOLD,XNEW
+132 ;
+133 ;Pull the top node
+134 SET ND=$GET(^DIA(FILE,AIEN,0))
+135 ;
+136 ;Get the date/time of change
+137 SET ADT=$PIECE(ND,U,2)
IF ADT=""
SET ADT=" "
+138 SET ADT=$$TMIN(ADT)
+139 ;
+140 ;Get change user
+141 SET AUSR=$PIECE(ND,U,4)
IF AUSR=""
SET AUSR=" "
+142 ;
+143 ;Get field changed
+144 SET FLD=$PIECE(ND,U,3)
IF FLD=""
QUIT
+145 ;
+146 ;Get the field name
+147 SET DFILE=FILE
+148 IF FLD[","
Begin DoDot:3
+149 NEW SFLD,SFILE,SBFLD
+150 SET SFLD=$PIECE(FLD,",")
IF SFLD=""
QUIT
+151 SET SBFLD=$PIECE(FLD,",",2)
IF SBFLD=""
QUIT
+152 SET SFILE=+$PIECE($GET(^DD(FILE,SFLD,0)),U,2)
IF SFLD=""
QUIT
+153 SET FLD=SBFLD
+154 SET DFILE=SFILE
End DoDot:3
+155 SET XFLD=$PIECE($GET(^DD(DFILE,FLD,0)),U)
IF XFLD=""
QUIT
+156 ;
+157 ;Get old value
+158 SET XOLD=$PIECE($GET(^DIA(FILE,AIEN,2)),U)
+159 ;
+160 ;Get new value
+161 SET XNEW=$PIECE($GET(^DIA(FILE,AIEN,3)),U)
+162 ;
+163 ;Set up sortable entry
+164 SET @RET@(ADT,AUSR,XFLD)=XOLD_U_XNEW_U_$PIECE(ND,U)
End DoDot:2
End DoDot:1
IF PIEN'[SBPRB
QUIT
+165 ;
+166 ;Add in qualifiers - EDITS/DELETES are also getting pulled from DIA
+167 ;Since the DIA field is EDIT/DELETE only, attempt to grab an add
+168 SET FNUM=9000011.13
SET XOLD=""
+169 SET IEN2=0
FOR
SET IEN2=$ORDER(^AUPNPROB(PRBIEN,13,IEN2))
IF '+IEN2
QUIT
Begin DoDot:1
+170 NEW AIEN,Q,BY,WHEN,XNEW
+171 SET AIEN=IEN2_","_PRBIEN_","
+172 SET XNEW=$$GET1^DIQ(FNUM,AIEN,.01)
+173 ;Skip the attribute entry
IF XNEW=246112005
QUIT
+174 SET BY=$$GET1^DIQ(FNUM,AIEN,.02,"I")
IF BY=""
SET BY=" "
+175 SET WHEN=$$TMIN($$GET1^DIQ(FNUM,AIEN,.03,"I"))
IF WHEN=""
SET WHEN=" "
+176 SET @RET@(WHEN,BY,"SEVERITY")=XOLD_U_XNEW_U_PRBIEN_","_IEN2
+177 SET XOLD=XNEW
End DoDot:1
+178 ;
+179 ;Get the Care Plans
+180 Begin DoDot:1
+181 NEW CDATA
+182 DO GET^BGOCPLAN(.CDATA,PRBIEN,DFN,"C","C","")
+183 DO PLAN
End DoDot:1
+184 ;
+185 ;Get the Goals
+186 Begin DoDot:1
+187 NEW CDATA
+188 DO GET^BGOCPLAN(.CDATA,PRBIEN,DFN,"G","C","")
+189 DO PLAN
End DoDot:1
+190 ;
+191 ;Get the Visit Instructions
+192 Begin DoDot:1
+193 NEW VDATA,VIEN
+194 DO GET^BGOVVI(.VDATA,DFN,PRBIEN,99999,"",.VIEN)
+195 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+196 DO VISIT
End DoDot:1
+197 ;
+198 ;Get the V Treatment Regimen
+199 Begin DoDot:1
+200 NEW TDATA,VIEN
+201 DO GET^BGOVTR(.TDATA,DFN,PRBIEN,99999,"",.VIEN)
+202 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+203 DO TREAT
End DoDot:1
+204 ;
+205 ;Get the Patient Education
+206 Begin DoDot:1
+207 NEW EDATA,VIEN
+208 DO GETEDU^BGOVTR(.EDATA,DFN,PRBIEN,99999,.VIEN)
+209 IF '$DATA(^TMP("BGOVIN",$JOB))
QUIT
+210 DO EDU
End DoDot:1
+211 ;
TMIN(TIME) ;Drop any seconds off the time
+1 QUIT +($PIECE(TIME,".")_"."_$EXTRACT($PIECE(TIME,".",2),1,4))
+2 ;
PLAN ;GET ALL CARE PLANNING DATA
+1 NEW CT2
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOPLAN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 NEW STR,TYPE,IEN,STS
+5 ;
+6 SET STR=$GET(^TMP("BGOPLAN",$JOB,CT2))
+7 IF $PIECE(STR,U,1)="~t"
QUIT
+8 ;
+9 ;Get the IEN
+10 SET TYPE=$PIECE(STR,U)
+11 SET IEN=$PIECE(STR,U,2)
IF IEN=""
QUIT
+12 ;
+13 ;Now loop through the history
+14 SET STS=0
FOR
SET STS=$ORDER(^AUPNCPL(IEN,11,STS))
IF 'STS
QUIT
Begin DoDot:2
+15 NEW DA,IENS,ADT,USR,XSTS
+16 SET DA(1)=IEN
SET DA=STS
SET IENS=$$IENS^DILF(.DA)
+17 SET ADT=$$GET1^DIQ(9000092.11,IENS,.03,"I")
IF ADT=""
SET ADT=" "
+18 SET ADT=$$TMIN(ADT)
+19 SET USR=$$GET1^DIQ(9000092.11,IENS,.02,"I")
IF USR=""
SET USR=" "
+20 SET XSTS=$$GET1^DIQ(9000092.11,IENS,.01,"E")
+21 SET @RET@(ADT,USR,$SELECT(TYPE="G":"GOAL.",1:"CARE.")_IEN)=XSTS
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT
+24 ;
VISIT ;GET ALL VISIT INSTRUCTION DATA
+1 NEW CT2
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 NEW STR,IEN
+5 ;
+6 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+7 IF $PIECE(STR,U,1)="~t"
QUIT
+8 ;
+9 ;Get the IEN
+10 SET IEN=$PIECE(STR,U,2)
IF IEN=""
QUIT
+11 ;
+12 ;Get entered date/time
+13 SET ADT=$$TMIN($$GET1^DIQ(9000010.58,IEN_",",1216,"I"))
IF ADT=""
SET ADT=" "
+14 ;
+15 ;Get entered by
+16 SET USR=$$GET1^DIQ(9000010.58,IEN_",",1217,"I")
IF USR=""
SET USR=" "
+17 ;
+18 ;Set up entry
+19 SET @RET@(ADT,USR,"VINS."_IEN)=""
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
TREAT ;GET ALL TREATMENT REGIMEN DATA
+1 NEW CT2
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 NEW STR,IEN
+5 ;
+6 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+7 ;
+8 ;Get the IEN
+9 SET IEN=$PIECE(STR,U,2)
IF IEN=""
QUIT
+10 ;
+11 ;Get entered date/time
+12 SET ADT=$$TMIN($$GET1^DIQ(9000010.61,IEN_",",1216,"I"))
IF ADT=""
SET ADT=" "
+13 ;
+14 ;Get entered by
+15 SET USR=$$GET1^DIQ(9000010.61,IEN_",",1217,"I")
IF USR=""
SET USR=" "
+16 ;
+17 ;Set up entry
+18 SET @RET@(ADT,USR,"VTR."_IEN)=""
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
EDU ;GET ALL EDUCATION DATA
+1 NEW CT2
+2 SET CT2=0
+3 FOR
SET CT2=$ORDER(^TMP("BGOVIN",$JOB,CT2))
IF '+CT2
QUIT
Begin DoDot:1
+4 NEW STR,IEN
+5 ;
+6 SET STR=$GET(^TMP("BGOVIN",$JOB,CT2))
+7 ;
+8 ;Get the IEN
+9 SET IEN=$PIECE(STR,U,6)
IF IEN=""
QUIT
+10 ;
+11 ;Get entered date/time
+12 SET ADT=$$TMIN($$GET1^DIQ(9000010.16,IEN_",",1216,"I"))
IF ADT=""
SET ADT=" "
+13 ;
+14 ;Get entered by
+15 SET USR=$$GET1^DIQ(9000010.16,IEN_",",1217,"I")
IF USR=""
SET USR=" "
+16 ;
+17 ;Set up entry
+18 SET @RET@(ADT,USR,"VEDU."_IEN)=""
+19 QUIT
End DoDot:1
+20 QUIT
