BGOVVI ; IHS/BAO/TMD - pull Visit files associated with problems ;26-Oct-2015 14:11;DU
;;1.1;BGO COMPONENTS;**13,14,17**;Mar 20, 2007;Build 13
;P14 changed to return time when entered
;---------------------------------------------
;Get Data from V Visit Instructions file
;Inp parameters:
; DFN
; PROB Ien
; Number to Return
; CNT
; SVIEN -visit ien
; PRV
;Return is list of visit instructions
;Array(n)="I" [1] ^ Instr IEN[2] ^ Prob IEN [3] ^ Vst Date [4] ^ Facility [5] ^ Prv IEN [6] ^ Location [7] ^ Entered Dt [8] ^ Visit IEN [9] ^V cat [10] ^ Locked [11] ^ Prov Name [12] ^ signed [12]
; =~t [1] ^Text of the item [2]
GET(DATA,DFN,PROB,NUM,CNT,SVIEN,PRV) ;EP
N X,REC,VCAT,VIN,VDT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME
N FNUM,VDATE,VIEN,EDATE,STDT,COMM,CT,SIGN,TXTIEN,INVDT
I $G(DATA)="" S DATA=$$TMPGBL
S PRV=$G(PRV)
;Return the instructions for the last visit by default
I $G(NUM)="" S NUM=1
I $G(CNT)="" S CNT=0
S SVIEN=$G(SVIEN)
S CT=0
;Visit not selected get problems
I SVIEN="" D
.;if provider not selected, get all required number
.I PRV="" D
..S INVDT="" F S INVDT=$O(^AUPNVVI("AE",DFN,PROB,INVDT)) Q:INVDT=""!(CT+1>NUM) D
...S VIN="" F S VIN=$O(^AUPNVVI("AE",DFN,PROB,INVDT,VIN)) Q:'+VIN D
....S REC=$G(^AUPNVVI(VIN,0))
....Q:REC=""
....D GETREC
.;Else find entries for this provider
.E D
..S INVDT="" F S INVDT=$O(^AUPNVVI("APRV",PROB,PRV,INVDT)) Q:'+INVDT!(CT+1>NUM) D
...S VIN="" F S VIN=$O(^AUPNVVI("APRV",PROB,PRV,INVDT,VIN)) Q:'+VIN D
....S REC=$G(^AUPNVVI(VIN,0))
....Q:REC=""
....D GETREC
;Find entries for a specific visit
I SVIEN'="" D
.S VIN="" F S VIN=$O(^AUPNVVI("AD",SVIEN,VIN)) Q:VIN="" D
..S REC=$G(^AUPNVVI(VIN,0))
..Q:REC=""
..D GETREC
Q
GETREC ;Get the record
S FNUM=$$FNUM
S PRVIEN=$P($G(^AUPNVVI(VIN,12)),U,4)
S PRVNAME=$S('PRVIEN:"",1:$P($G(^VA(200,+PRVIEN,0)),U))
S VIEN=$P(REC,U,3)
Q:'VIEN
Q:$$GET1^DIQ(9000010.58,VIN,.06,"I")=1
S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6)
S FAC=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U,10),1:"")
S FACNAM=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U),1:"")
S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)
S:$P($G(^AUPNVSIT(VIEN,21)),U)'="" FACNAM=$P(^(21),U)
S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
S VDT=$P($G(^AUPNVSIT(VIEN,0)),U,1)
S EDATE=$$GET1^DIQ(9000010.58,VIN,1201,"I")
S SIGN=$$GET1^DIQ(9000010.58,VIN,.05,"I")
Q:(SIGN="")&(DUZ'=$$GET1^DIQ(9000010.58,VIN,1204,"I"))
I EDATE="" S EDATE=VDT
S VDATE=$$FMTDATE^BGOUTL(VDT,1)
S EDATE=$$FMTDATE^BGOUTL(EDATE,1)
S SIGN=$$FMTDATE^BGOUTL(SIGN)
S CNT=CNT+1,CT=CT+1
S @DATA@(CNT)="I"_U_VIN_U_PROB_U_VDATE_U_FACNAM_U_PRVIEN_U_LOC_U_EDATE_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_PRVNAME_U_SIGN
S TXTIEN=0 F S TXTIEN=$O(^AUPNVVI(VIN,11,TXTIEN)) Q:'+TXTIEN D
.S CNT=CNT+1
.;IHS/MSC/MGH changed for carriage returns P17
.S @DATA@(CNT)="~t"_U_$TR($G(^AUPNVVI(VIN,11,TXTIEN,0)),$C(13,10))
Q
; Delete a V Visit Instruction entry
;INP=VFIEN ^ DELETE REASON ^ OTHER
DEL(RET,INP) ;EP
N COMMENT,FDA,REASON,VFIEN
S VFIEN=$P(INP,U)
I $$GET1^DIQ(9000010.58,VFIEN,.05)="" D
.D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
E D
.S REASON=$P(INP,U,2)
.S COMMENT=$P(INP,U,3)
.I VFIEN="" S RET=$$ERR^BGOUTL(1008) Q ; Missing input data
.I '$D(^AUPNVVI(VFIEN)) S RET=$$ERR^BGOUTL(1035) Q ; Item not found
.S FDA=$NA(FDA($$FNUM,VFIEN_","))
.S @FDA@(.06)=1
.S @FDA@(.07)=DUZ
.S @FDA@(1218)=$$NOW^XLFDT()
.S @FDA@(1219)=DUZ
.S @FDA@(.08)=REASON
.S @FDA@(.09)=COMMENT
.S RET=$$UPDATE^BGOUTL(.FDA,,VFIEN)
.S:RET="" RET=1
Q
;Set data into this file
;INP = VVI IEN [1] ^ Visit IEN [2] ^ Problem IEN [3] ^ Patient IEN [4] ^ Evnt Dt [5] ^ Provider [6]
;INSTR(N)= Array of instructions
SET(RET,INP,INSTR) ;EP
N VFIEN,NEW,VIEN,PROB,EVDT,DFN,PRV,FDA,IEN,FNUM,VFNEW
S FNUM=$$FNUM
S VFIEN=+INP
I VFIEN="" S NEW=1
S VFNEW='VFIEN
S VIEN=$P(INP,U,2)
S PROB=$P(INP,U,3)
I 'PROB S RET="-1^No problem in input string" Q
I 'VIEN S RET=$$ERR^BGOUTL(1008) Q
S DFN=$P(INP,U,4)
S EVDT=$P(INP,U,5)
I EVDT="" S EVDT=$$NOW^XLFDT
S PRV=$P(INP,U,6) I PRV="" S PRV=DUZ
S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
Q:RET
I 'VFIEN D Q:'VFIEN
.D VFNEW^BGOUTL2(.RET,FNUM,PROB,VIEN)
.S:RET>0 VFIEN=RET ;,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(1201)=EVDT
S @FDA@(1204)="`"_PRV
I VFNEW D
.S @FDA@(1216)="N"
.S @FDA@(1217)="`"_DUZ
S @FDA@(1218)="N"
S @FDA@(1219)="`"_DUZ
S RET=$$UPDATE^BGOUTL(.FDA,"E@")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
Q:RET
;Add in the text of the item
N VAL,ICNT,I
S ICNT=0
S I="" F S I=$O(INSTR(I)) Q:I="" D
.S ICNT=ICNT+1
.S VAL(ICNT,0)=$G(INSTR(I))
D WP^DIE(9000010.58,VFIEN_",",1100,,"VAL")
S RET=VFIEN
Q ;RET
;Mark record when signed
SIGN(RET,VVII,BY) ;EP
N FDA,AIEN,ERR
S RET="",ERR=""
I $$GET1^DIQ(9000010.58,VVII,.05)'="" S RET="-1^Already signed" Q RET
S AIEN=VVII_","
S FDA(9000010.58,AIEN,.04)=BY
S FDA(9000010.58,AIEN,.05)=$$NOW^XLFDT
D FILE^DIE("","FDA","ERR")
I ERR S RET=-1_U_"Unable to sign Visit Instructions"
Q RET
GETPRV(RET,IEN) ;Get providers associated with problems
N X,PRV,PRVNAME
S RET=$$TMPGBL
;Goal notes
S PRV=""
F S PRV=$O(^AUPNCPL("APTP",IEN,"G",PRV)) Q:'+PRV D
.I $D(^AUPNCPL("APTP",IEN,"G",PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..S @RET@(PRV)=PRV_U_PRVNAME_U_"G"
;Care plans
S PRV="" S PRV=$O(^AUPNCPL("APTP",IEN,"P",PRV)) Q:'+PRV D
.I $D(^AUPNCPL("APTP",IEN,"P",PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..I '$D(@RET@(PRV)) D
...S @RET@(PRV)=PRV_U_PRVNAME_U_"C"
..E D
...S X=$P($G(@RET@(PRV)),U,3)
...S X=X_"P"
...S @RET@(PRV)=PRV_U_PRVNAME_U_X
;Visit Instructions
S PRV="" F S PRV=$O(^AUPNVVI("APRV",IEN,PRV)) Q:'+PRV D
.I $D(^AUPNVVI("APRV",IEN,PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"V"
..E D
...S X=$P($G(@RET@(PRV)),U,3)
...S X=X_"V"
...S @RET@(PRV)=PRV_U_PRVNAME_U_X
;Visit treatments
S PRV="" F S PRV=$O(^AUPNVTXR("APRV",IEN,PRV)) Q:'+PRV D
.I $D(^AUPNVTXR("APRV",IEN,PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"T"
..E D
...S X=$P($G(@RET@(PRV)),U,3)
...S X=X_"T"
...S @RET@(PRV)=PRV_U_PRVNAME_U_X
;Referrals
S PRV="" F S PRV=$O(^AUPNVREF("APRV",IEN,PRV)) Q:'+PRV D
.I $D(^AUPNVREF("APRV",IEN,PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"R"
..E D
...S X=$P($G(@RET@(PRV)),U,3)
...S X=X_"R"
...S @RET@(PRV)=PRV_U_PRVNAME_U_X
Q
;Consults
S PRV="" F S PRV=$O(^GMR(123,"APRV",IEN,PRV)) Q:'+PRV D
.I $D(^GMR(123,"APRV",IEN,PRV))>0 D
..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"S"
..E D
...S X=$P($G(@RET@(PRV)),U,3)
...S X=X_"C"
...S @RET@(PRV)=PRV_U_PRVNAME_U_X
;Education
Q
;Input
;DFN of patient
;Problem IEN
;Provider IEN
;Number to return
PRVDATA(DATA,DFN,PROB,PRV,NUM) ;EP return data for a provider
N CNT
I $G(NUM)="" S NUM=1
S CNT=0
S DATA=$$TMPGBL
D GET^BGOCPLAN(.DATA,PROB,DFN,"G",NUM,.CNT,PRV)
D GET^BGOCPLAN(.DATA,PROB,DFN,"P",NUM,.CNT,PRV)
D GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
D GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
D GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,PRV)
D GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
D GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
Q
PROBDATA(DATA,PROB,NUM) ;Get data for one problem
N CNT,DFN,RETI
S DATA=$$TMPGBL
I $G(PROB)="" S @DATA@(1)="-1^Undefined problem" Q
S DFN=$$GET1^DIQ(9000011,PROB,.02,"I")
I '+DFN S @DATA@(1)="-1^Unknown patient for this problem" Q
I $G(NUM)="" S NUM=9999999
S CNT=0
S RETI="C"
D GET^BGOCPLAN(.DATA,PROB,DFN,"G",RETI,.CNT,"")
D GET^BGOCPLAN(.DATA,PROB,DFN,"P",RETI,.CNT,"")
D GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"","")
D GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
D GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"")
D GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
D GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
Q
;EIE can only be done by the author or the chief of MIS
;Input = IEN of the entry [1] ^ user deleting [2]
OKDEL(RET,IEN,USER) ;EP Can this user delete
N PRV,ENTRYDT,ERR
S RET=0
I $G(USER)="" S USER=DUZ
S PRV=$$GET1^DIQ(9000010.58,IEN,1204,"I")
I PRV=USER S RET=1 Q
S ENTRYDT=$$NOW^XLFDT
S ERR=""
S RET=$$ISA^TIUPS139(USER,"CHIEF, MIS",ERR)
Q
;Input parameter
;INP= Visit instruction ien [1] ^ Reason for eie [2] ^ comment if other [3]
EIE(RET,INP) ;Mark an entry entered in error
N FNUM,IEN2,FDA,IEN,REASON,CMMT,IENS,RET
S RET=""
S IENS=$P(INP,U,1)
S REASON=$P(INP,U,2)
S CMMT=$P(INP,U,3)
S FNUM=9000010.58
S IEN2=IENS_","
S FDA=$NA(FDA(FNUM,IEN2))
S @FDA@(.06)=1
S @FDA@(.07)=DUZ
S @FDA@(.08)=$$NOW^XLFDT()
S @FDA@(.08)=REASON
S @FDA@(.09)=CMMT
S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
Q
TMPGBL(X) ;EP
K ^TMP("BGOVIN",$J) Q $NA(^($J))
; Return file number
FNUM() Q 9000010.58
BGOVVI ; IHS/BAO/TMD - pull Visit files associated with problems ;26-Oct-2015 14:11;DU
+1 ;;1.1;BGO COMPONENTS;**13,14,17**;Mar 20, 2007;Build 13
+2 ;P14 changed to return time when entered
+3 ;---------------------------------------------
+4 ;Get Data from V Visit Instructions file
+5 ;Inp parameters:
+6 ; DFN
+7 ; PROB Ien
+8 ; Number to Return
+9 ; CNT
+10 ; SVIEN -visit ien
+11 ; PRV
+12 ;Return is list of visit instructions
+13 ;Array(n)="I" [1] ^ Instr IEN[2] ^ Prob IEN [3] ^ Vst Date [4] ^ Facility [5] ^ Prv IEN [6] ^ Location [7] ^ Entered Dt [8] ^ Visit IEN [9] ^V cat [10] ^ Locked [11] ^ Prov Name [12] ^ signed [12]
+14 ; =~t [1] ^Text of the item [2]
GET(DATA,DFN,PROB,NUM,CNT,SVIEN,PRV) ;EP
+1 NEW X,REC,VCAT,VIN,VDT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME
+2 NEW FNUM,VDATE,VIEN,EDATE,STDT,COMM,CT,SIGN,TXTIEN,INVDT
+3 IF $GET(DATA)=""
SET DATA=$$TMPGBL
+4 SET PRV=$GET(PRV)
+5 ;Return the instructions for the last visit by default
+6 IF $GET(NUM)=""
SET NUM=1
+7 IF $GET(CNT)=""
SET CNT=0
+8 SET SVIEN=$GET(SVIEN)
+9 SET CT=0
+10 ;Visit not selected get problems
+11 IF SVIEN=""
Begin DoDot:1
+12 ;if provider not selected, get all required number
+13 IF PRV=""
Begin DoDot:2
+14 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVVI("AE",DFN,PROB,INVDT))
IF INVDT=""!(CT+1>NUM)
QUIT
Begin DoDot:3
+15 SET VIN=""
FOR
SET VIN=$ORDER(^AUPNVVI("AE",DFN,PROB,INVDT,VIN))
IF '+VIN
QUIT
Begin DoDot:4
+16 SET REC=$GET(^AUPNVVI(VIN,0))
+17 IF REC=""
QUIT
+18 DO GETREC
End DoDot:4
End DoDot:3
End DoDot:2
+19 ;Else find entries for this provider
+20 IF '$TEST
Begin DoDot:2
+21 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVVI("APRV",PROB,PRV,INVDT))
IF '+INVDT!(CT+1>NUM)
QUIT
Begin DoDot:3
+22 SET VIN=""
FOR
SET VIN=$ORDER(^AUPNVVI("APRV",PROB,PRV,INVDT,VIN))
IF '+VIN
QUIT
Begin DoDot:4
+23 SET REC=$GET(^AUPNVVI(VIN,0))
+24 IF REC=""
QUIT
+25 DO GETREC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+26 ;Find entries for a specific visit
+27 IF SVIEN'=""
Begin DoDot:1
+28 SET VIN=""
FOR
SET VIN=$ORDER(^AUPNVVI("AD",SVIEN,VIN))
IF VIN=""
QUIT
Begin DoDot:2
+29 SET REC=$GET(^AUPNVVI(VIN,0))
+30 IF REC=""
QUIT
+31 DO GETREC
End DoDot:2
End DoDot:1
+32 QUIT
GETREC ;Get the record
+1 SET FNUM=$$FNUM
+2 SET PRVIEN=$PIECE($GET(^AUPNVVI(VIN,12)),U,4)
+3 SET PRVNAME=$SELECT('PRVIEN:"",1:$PIECE($GET(^VA(200,+PRVIEN,0)),U))
+4 SET VIEN=$PIECE(REC,U,3)
+5 IF 'VIEN
QUIT
+6 IF $$GET1^DIQ(9000010.58,VIN,.06,"I")=1
QUIT
+7 SET LOC=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,6)
+8 SET FAC=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U,10),1:"")
+9 SET FACNAM=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U),1:"")
+10 IF FACNAM
SET FACNAM=$PIECE($GET(^DIC(4,FACNAM,0)),U)
+11 IF $PIECE($GET(^AUPNVSIT(VIEN,21)),U)'=""
SET FACNAM=$PIECE(^(21),U)
+12 SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)
+13 SET VDT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,1)
+14 SET EDATE=$$GET1^DIQ(9000010.58,VIN,1201,"I")
+15 SET SIGN=$$GET1^DIQ(9000010.58,VIN,.05,"I")
+16 IF (SIGN="")&(DUZ'=$$GET1^DIQ(9000010.58,VIN,1204,"I"))
QUIT
+17 IF EDATE=""
SET EDATE=VDT
+18 SET VDATE=$$FMTDATE^BGOUTL(VDT,1)
+19 SET EDATE=$$FMTDATE^BGOUTL(EDATE,1)
+20 SET SIGN=$$FMTDATE^BGOUTL(SIGN)
+21 SET CNT=CNT+1
SET CT=CT+1
+22 SET @DATA@(CNT)="I"_U_VIN_U_PROB_U_VDATE_U_FACNAM_U_PRVIEN_U_LOC_U_EDATE_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_PRVNAME_U_SIGN
+23 SET TXTIEN=0
FOR
SET TXTIEN=$ORDER(^AUPNVVI(VIN,11,TXTIEN))
IF '+TXTIEN
QUIT
Begin DoDot:1
+24 SET CNT=CNT+1
+25 ;IHS/MSC/MGH changed for carriage returns P17
+26 SET @DATA@(CNT)="~t"_U_$TRANSLATE($GET(^AUPNVVI(VIN,11,TXTIEN,0)),$CHAR(13,10))
End DoDot:1
+27 QUIT
+28 ; Delete a V Visit Instruction entry
+29 ;INP=VFIEN ^ DELETE REASON ^ OTHER
DEL(RET,INP) ;EP
+1 NEW COMMENT,FDA,REASON,VFIEN
+2 SET VFIEN=$PIECE(INP,U)
+3 IF $$GET1^DIQ(9000010.58,VFIEN,.05)=""
Begin DoDot:1
+4 DO VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET REASON=$PIECE(INP,U,2)
+7 SET COMMENT=$PIECE(INP,U,3)
+8 ; Missing input data
IF VFIEN=""
SET RET=$$ERR^BGOUTL(1008)
QUIT
+9 ; Item not found
IF '$DATA(^AUPNVVI(VFIEN))
SET RET=$$ERR^BGOUTL(1035)
QUIT
+10 SET FDA=$NAME(FDA($$FNUM,VFIEN_","))
+11 SET @FDA@(.06)=1
+12 SET @FDA@(.07)=DUZ
+13 SET @FDA@(1218)=$$NOW^XLFDT()
+14 SET @FDA@(1219)=DUZ
+15 SET @FDA@(.08)=REASON
+16 SET @FDA@(.09)=COMMENT
+17 SET RET=$$UPDATE^BGOUTL(.FDA,,VFIEN)
+18 IF RET=""
SET RET=1
End DoDot:1
+19 QUIT
+20 ;Set data into this file
+21 ;INP = VVI IEN [1] ^ Visit IEN [2] ^ Problem IEN [3] ^ Patient IEN [4] ^ Evnt Dt [5] ^ Provider [6]
+22 ;INSTR(N)= Array of instructions
SET(RET,INP,INSTR) ;EP
+1 NEW VFIEN,NEW,VIEN,PROB,EVDT,DFN,PRV,FDA,IEN,FNUM,VFNEW
+2 SET FNUM=$$FNUM
+3 SET VFIEN=+INP
+4 IF VFIEN=""
SET NEW=1
+5 SET VFNEW='VFIEN
+6 SET VIEN=$PIECE(INP,U,2)
+7 SET PROB=$PIECE(INP,U,3)
+8 IF 'PROB
SET RET="-1^No problem in input string"
QUIT
+9 IF 'VIEN
SET RET=$$ERR^BGOUTL(1008)
QUIT
+10 SET DFN=$PIECE(INP,U,4)
+11 SET EVDT=$PIECE(INP,U,5)
+12 IF EVDT=""
SET EVDT=$$NOW^XLFDT
+13 SET PRV=$PIECE(INP,U,6)
IF PRV=""
SET PRV=DUZ
+14 SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
+15 IF RET
QUIT
+16 IF 'VFIEN
Begin DoDot:1
+17 DO VFNEW^BGOUTL2(.RET,FNUM,PROB,VIEN)
+18 ;,RET=""
IF RET>0
SET VFIEN=RET
End DoDot:1
IF 'VFIEN
QUIT
+19 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+20 SET @FDA@(1201)=EVDT
+21 SET @FDA@(1204)="`"_PRV
+22 IF VFNEW
Begin DoDot:1
+23 SET @FDA@(1216)="N"
+24 SET @FDA@(1217)="`"_DUZ
End DoDot:1
+25 SET @FDA@(1218)="N"
+26 SET @FDA@(1219)="`"_DUZ
+27 SET RET=$$UPDATE^BGOUTL(.FDA,"E@")
+28 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+29 IF RET
QUIT
+30 ;Add in the text of the item
+31 NEW VAL,ICNT,I
+32 SET ICNT=0
+33 SET I=""
FOR
SET I=$ORDER(INSTR(I))
IF I=""
QUIT
Begin DoDot:1
+34 SET ICNT=ICNT+1
+35 SET VAL(ICNT,0)=$GET(INSTR(I))
End DoDot:1
+36 DO WP^DIE(9000010.58,VFIEN_",",1100,,"VAL")
+37 SET RET=VFIEN
+38 ;RET
QUIT
+39 ;Mark record when signed
SIGN(RET,VVII,BY) ;EP
+1 NEW FDA,AIEN,ERR
+2 SET RET=""
SET ERR=""
+3 IF $$GET1^DIQ(9000010.58,VVII,.05)'=""
SET RET="-1^Already signed"
QUIT RET
+4 SET AIEN=VVII_","
+5 SET FDA(9000010.58,AIEN,.04)=BY
+6 SET FDA(9000010.58,AIEN,.05)=$$NOW^XLFDT
+7 DO FILE^DIE("","FDA","ERR")
+8 IF ERR
SET RET=-1_U_"Unable to sign Visit Instructions"
+9 QUIT RET
GETPRV(RET,IEN) ;Get providers associated with problems
+1 NEW X,PRV,PRVNAME
+2 SET RET=$$TMPGBL
+3 ;Goal notes
+4 SET PRV=""
+5 FOR
SET PRV=$ORDER(^AUPNCPL("APTP",IEN,"G",PRV))
IF '+PRV
QUIT
Begin DoDot:1
+6 IF $DATA(^AUPNCPL("APTP",IEN,"G",PRV))>0
Begin DoDot:2
+7 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+8 SET @RET@(PRV)=PRV_U_PRVNAME_U_"G"
End DoDot:2
End DoDot:1
+9 ;Care plans
+10 SET PRV=""
SET PRV=$ORDER(^AUPNCPL("APTP",IEN,"P",PRV))
IF '+PRV
QUIT
Begin DoDot:1
+11 IF $DATA(^AUPNCPL("APTP",IEN,"P",PRV))>0
Begin DoDot:2
+12 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+13 IF '$DATA(@RET@(PRV))
Begin DoDot:3
+14 SET @RET@(PRV)=PRV_U_PRVNAME_U_"C"
End DoDot:3
+15 IF '$TEST
Begin DoDot:3
+16 SET X=$PIECE($GET(@RET@(PRV)),U,3)
+17 SET X=X_"P"
+18 SET @RET@(PRV)=PRV_U_PRVNAME_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;Visit Instructions
+20 SET PRV=""
FOR
SET PRV=$ORDER(^AUPNVVI("APRV",IEN,PRV))
IF '+PRV
QUIT
Begin DoDot:1
+21 IF $DATA(^AUPNVVI("APRV",IEN,PRV))>0
Begin DoDot:2
+22 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+23 IF '$DATA(@RET@(PRV))
SET @RET@(PRV)=PRV_U_PRVNAME_U_"V"
+24 IF '$TEST
Begin DoDot:3
+25 SET X=$PIECE($GET(@RET@(PRV)),U,3)
+26 SET X=X_"V"
+27 SET @RET@(PRV)=PRV_U_PRVNAME_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;Visit treatments
+29 SET PRV=""
FOR
SET PRV=$ORDER(^AUPNVTXR("APRV",IEN,PRV))
IF '+PRV
QUIT
Begin DoDot:1
+30 IF $DATA(^AUPNVTXR("APRV",IEN,PRV))>0
Begin DoDot:2
+31 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+32 IF '$DATA(@RET@(PRV))
SET @RET@(PRV)=PRV_U_PRVNAME_U_"T"
+33 IF '$TEST
Begin DoDot:3
+34 SET X=$PIECE($GET(@RET@(PRV)),U,3)
+35 SET X=X_"T"
+36 SET @RET@(PRV)=PRV_U_PRVNAME_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;Referrals
+38 SET PRV=""
FOR
SET PRV=$ORDER(^AUPNVREF("APRV",IEN,PRV))
IF '+PRV
QUIT
Begin DoDot:1
+39 IF $DATA(^AUPNVREF("APRV",IEN,PRV))>0
Begin DoDot:2
+40 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+41 IF '$DATA(@RET@(PRV))
SET @RET@(PRV)=PRV_U_PRVNAME_U_"R"
+42 IF '$TEST
Begin DoDot:3
+43 SET X=$PIECE($GET(@RET@(PRV)),U,3)
+44 SET X=X_"R"
+45 SET @RET@(PRV)=PRV_U_PRVNAME_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;Consults
+48 SET PRV=""
FOR
SET PRV=$ORDER(^GMR(123,"APRV",IEN,PRV))
IF '+PRV
QUIT
Begin DoDot:1
+49 IF $DATA(^GMR(123,"APRV",IEN,PRV))>0
Begin DoDot:2
+50 SET PRVNAME=$$GET1^DIQ(200,PRV,.01)
+51 IF '$DATA(@RET@(PRV))
SET @RET@(PRV)=PRV_U_PRVNAME_U_"S"
+52 IF '$TEST
Begin DoDot:3
+53 SET X=$PIECE($GET(@RET@(PRV)),U,3)
+54 SET X=X_"C"
+55 SET @RET@(PRV)=PRV_U_PRVNAME_U_X
End DoDot:3
End DoDot:2
End DoDot:1
+56 ;Education
+57 QUIT
+58 ;Input
+59 ;DFN of patient
+60 ;Problem IEN
+61 ;Provider IEN
+62 ;Number to return
PRVDATA(DATA,DFN,PROB,PRV,NUM) ;EP return data for a provider
+1 NEW CNT
+2 IF $GET(NUM)=""
SET NUM=1
+3 SET CNT=0
+4 SET DATA=$$TMPGBL
+5 DO GET^BGOCPLAN(.DATA,PROB,DFN,"G",NUM,.CNT,PRV)
+6 DO GET^BGOCPLAN(.DATA,PROB,DFN,"P",NUM,.CNT,PRV)
+7 DO GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
+8 DO GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
+9 DO GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,PRV)
+10 DO GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
+11 DO GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
+12 QUIT
PROBDATA(DATA,PROB,NUM) ;Get data for one problem
+1 NEW CNT,DFN,RETI
+2 SET DATA=$$TMPGBL
+3 IF $GET(PROB)=""
SET @DATA@(1)="-1^Undefined problem"
QUIT
+4 SET DFN=$$GET1^DIQ(9000011,PROB,.02,"I")
+5 IF '+DFN
SET @DATA@(1)="-1^Unknown patient for this problem"
QUIT
+6 IF $GET(NUM)=""
SET NUM=9999999
+7 SET CNT=0
+8 SET RETI="C"
+9 DO GET^BGOCPLAN(.DATA,PROB,DFN,"G",RETI,.CNT,"")
+10 DO GET^BGOCPLAN(.DATA,PROB,DFN,"P",RETI,.CNT,"")
+11 DO GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"","")
+12 DO GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
+13 DO GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"")
+14 DO GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
+15 DO GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
+16 QUIT
+17 ;EIE can only be done by the author or the chief of MIS
+18 ;Input = IEN of the entry [1] ^ user deleting [2]
OKDEL(RET,IEN,USER) ;EP Can this user delete
+1 NEW PRV,ENTRYDT,ERR
+2 SET RET=0
+3 IF $GET(USER)=""
SET USER=DUZ
+4 SET PRV=$$GET1^DIQ(9000010.58,IEN,1204,"I")
+5 IF PRV=USER
SET RET=1
QUIT
+6 SET ENTRYDT=$$NOW^XLFDT
+7 SET ERR=""
+8 SET RET=$$ISA^TIUPS139(USER,"CHIEF, MIS",ERR)
+9 QUIT
+10 ;Input parameter
+11 ;INP= Visit instruction ien [1] ^ Reason for eie [2] ^ comment if other [3]
EIE(RET,INP) ;Mark an entry entered in error
+1 NEW FNUM,IEN2,FDA,IEN,REASON,CMMT,IENS,RET
+2 SET RET=""
+3 SET IENS=$PIECE(INP,U,1)
+4 SET REASON=$PIECE(INP,U,2)
+5 SET CMMT=$PIECE(INP,U,3)
+6 SET FNUM=9000010.58
+7 SET IEN2=IENS_","
+8 SET FDA=$NAME(FDA(FNUM,IEN2))
+9 SET @FDA@(.06)=1
+10 SET @FDA@(.07)=DUZ
+11 SET @FDA@(.08)=$$NOW^XLFDT()
+12 SET @FDA@(.08)=REASON
+13 SET @FDA@(.09)=CMMT
+14 SET RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
+15 QUIT
TMPGBL(X) ;EP
+1 KILL ^TMP("BGOVIN",$JOB)
QUIT $NAME(^($JOB))
+2 ; Return file number
FNUM() QUIT 9000010.58
