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

BGOVVI.m

Go to the documentation of this file. 
  1. 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
  1.  ;P14 changed to return time when entered
  1.  ;---------------------------------------------
  1.  ;Get Data from V Visit Instructions file
  1.  ;Inp parameters:
  1.  ;    DFN
  1.  ;    PROB Ien
  1.  ;    Number to Return
  1.  ;    CNT
  1.  ;    SVIEN -visit ien
  1.  ;    PRV
  1.  ;Return is list of visit instructions
  1.  ;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]
  1.  ;          =~t [1] ^Text of the item [2]
  1. GET(DATA,DFN,PROB,NUM,CNT,SVIEN,PRV) ;EP
  1.  N X,REC,VCAT,VIN,VDT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME
  1.  N FNUM,VDATE,VIEN,EDATE,STDT,COMM,CT,SIGN,TXTIEN,INVDT
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  S PRV=$G(PRV)
  1.  ;Return the instructions for the last visit by default
  1.  I $G(NUM)="" S NUM=1
  1.  I $G(CNT)="" S CNT=0
  1.  S SVIEN=$G(SVIEN)
  1.  S CT=0
  1.  ;Visit not selected get problems
  1.  I SVIEN="" D
  1.  .;if provider not selected, get all required number
  1.  .I PRV="" D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVVI("AE",DFN,PROB,INVDT)) Q:INVDT=""!(CT+1>NUM)  D
  1.  ...S VIN="" F  S VIN=$O(^AUPNVVI("AE",DFN,PROB,INVDT,VIN)) Q:'+VIN  D
  1.  ....S REC=$G(^AUPNVVI(VIN,0))
  1.  ....Q:REC=""
  1.  ....D GETREC
  1.  .;Else find entries for this provider
  1.  .E  D
  1.  ..S INVDT="" F  S INVDT=$O(^AUPNVVI("APRV",PROB,PRV,INVDT)) Q:'+INVDT!(CT+1>NUM)  D
  1.  ...S VIN="" F  S VIN=$O(^AUPNVVI("APRV",PROB,PRV,INVDT,VIN)) Q:'+VIN  D
  1.  ....S REC=$G(^AUPNVVI(VIN,0))
  1.  ....Q:REC=""
  1.  ....D GETREC
  1.  ;Find entries for a specific visit
  1.  I SVIEN'="" D
  1.  .S VIN="" F  S VIN=$O(^AUPNVVI("AD",SVIEN,VIN)) Q:VIN=""  D
  1.  ..S REC=$G(^AUPNVVI(VIN,0))
  1.  ..Q:REC=""
  1.  ..D GETREC
  1.  Q
  1. GETREC ;Get the record
  1.  S FNUM=$$FNUM
  1.  S PRVIEN=$P($G(^AUPNVVI(VIN,12)),U,4)
  1.  S PRVNAME=$S('PRVIEN:"",1:$P($G(^VA(200,+PRVIEN,0)),U))
  1.  S VIEN=$P(REC,U,3)
  1.  Q:'VIEN
  1.  Q:$$GET1^DIQ(9000010.58,VIN,.06,"I")=1
  1.  S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6)
  1.  S FAC=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U,10),1:"")
  1.  S FACNAM=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U),1:"")
  1.  S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)
  1.  S:$P($G(^AUPNVSIT(VIEN,21)),U)'="" FACNAM=$P(^(21),U)
  1.  S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)
  1.  S VDT=$P($G(^AUPNVSIT(VIEN,0)),U,1)
  1.  S EDATE=$$GET1^DIQ(9000010.58,VIN,1201,"I")
  1.  S SIGN=$$GET1^DIQ(9000010.58,VIN,.05,"I")
  1.  Q:(SIGN="")&(DUZ'=$$GET1^DIQ(9000010.58,VIN,1204,"I"))
  1.  I EDATE="" S EDATE=VDT
  1.  S VDATE=$$FMTDATE^BGOUTL(VDT,1)
  1.  S EDATE=$$FMTDATE^BGOUTL(EDATE,1)
  1.  S SIGN=$$FMTDATE^BGOUTL(SIGN)
  1.  S CNT=CNT+1,CT=CT+1
  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
  1.  S TXTIEN=0 F  S TXTIEN=$O(^AUPNVVI(VIN,11,TXTIEN)) Q:'+TXTIEN  D
  1.  .S CNT=CNT+1
  1.  .;IHS/MSC/MGH changed for carriage returns P17
  1.  .S @DATA@(CNT)="~t"_U_$TR($G(^AUPNVVI(VIN,11,TXTIEN,0)),$C(13,10))
  1.  Q
  1.  ; Delete a V Visit Instruction entry
  1.  ;INP=VFIEN ^ DELETE REASON ^ OTHER
  1. DEL(RET,INP) ;EP
  1.  N COMMENT,FDA,REASON,VFIEN
  1.  S VFIEN=$P(INP,U)
  1.  I $$GET1^DIQ(9000010.58,VFIEN,.05)="" D
  1.  .D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
  1.  E  D
  1.  .S REASON=$P(INP,U,2)
  1.  .S COMMENT=$P(INP,U,3)
  1.  .I VFIEN="" S RET=$$ERR^BGOUTL(1008) Q  ; Missing input data
  1.  .I '$D(^AUPNVVI(VFIEN)) S RET=$$ERR^BGOUTL(1035) Q  ; Item not found
  1.  .S FDA=$NA(FDA($$FNUM,VFIEN_","))
  1.  .S @FDA@(.06)=1
  1.  .S @FDA@(.07)=DUZ
  1.  .S @FDA@(1218)=$$NOW^XLFDT()
  1.  .S @FDA@(1219)=DUZ
  1.  .S @FDA@(.08)=REASON
  1.  .S @FDA@(.09)=COMMENT
  1.  .S RET=$$UPDATE^BGOUTL(.FDA,,VFIEN)
  1.  .S:RET="" RET=1
  1.  Q
  1.  ;Set data into this file
  1.  ;INP = VVI IEN [1] ^ Visit IEN [2] ^ Problem IEN [3] ^ Patient IEN [4] ^ Evnt Dt [5] ^ Provider [6]
  1.  ;INSTR(N)= Array of instructions
  1. SET(RET,INP,INSTR) ;EP
  1.  N VFIEN,NEW,VIEN,PROB,EVDT,DFN,PRV,FDA,IEN,FNUM,VFNEW
  1.  S FNUM=$$FNUM
  1.  S VFIEN=+INP
  1.  I VFIEN="" S NEW=1
  1.  S VFNEW='VFIEN
  1.  S VIEN=$P(INP,U,2)
  1.  S PROB=$P(INP,U,3)
  1.  I 'PROB S RET="-1^No problem in input string" Q
  1.  I 'VIEN S RET=$$ERR^BGOUTL(1008) Q
  1.  S DFN=$P(INP,U,4)
  1.  S EVDT=$P(INP,U,5)
  1.  I EVDT="" S EVDT=$$NOW^XLFDT
  1.  S PRV=$P(INP,U,6) I PRV="" S PRV=DUZ
  1.  S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)
  1.  Q:RET
  1.  I 'VFIEN D  Q:'VFIEN
  1.  .D VFNEW^BGOUTL2(.RET,FNUM,PROB,VIEN)
  1.  .S:RET>0 VFIEN=RET ;,RET=""
  1.  S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  S @FDA@(1201)=EVDT
  1.  S @FDA@(1204)="`"_PRV
  1.  I VFNEW D
  1.  .S @FDA@(1216)="N"
  1.  .S @FDA@(1217)="`"_DUZ
  1.  S @FDA@(1218)="N"
  1.  S @FDA@(1219)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E@")
  1.  I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  Q:RET
  1.  ;Add in the text of the item
  1.  N VAL,ICNT,I
  1.  S ICNT=0
  1.  S I="" F  S I=$O(INSTR(I)) Q:I=""  D
  1.  .S ICNT=ICNT+1
  1.  .S VAL(ICNT,0)=$G(INSTR(I))
  1.  D WP^DIE(9000010.58,VFIEN_",",1100,,"VAL")
  1.  S RET=VFIEN
  1.  Q  ;RET
  1.  ;Mark record when signed
  1. SIGN(RET,VVII,BY) ;EP
  1.  N FDA,AIEN,ERR
  1.  S RET="",ERR=""
  1.  I $$GET1^DIQ(9000010.58,VVII,.05)'="" S RET="-1^Already signed" Q RET
  1.  S AIEN=VVII_","
  1.  S FDA(9000010.58,AIEN,.04)=BY
  1.  S FDA(9000010.58,AIEN,.05)=$$NOW^XLFDT
  1.  D FILE^DIE("","FDA","ERR")
  1.  I ERR S RET=-1_U_"Unable to sign Visit Instructions"
  1.  Q RET
  1. GETPRV(RET,IEN) ;Get providers associated with problems
  1.  N X,PRV,PRVNAME
  1.  S RET=$$TMPGBL
  1.  ;Goal notes
  1.  S PRV=""
  1.  F  S PRV=$O(^AUPNCPL("APTP",IEN,"G",PRV)) Q:'+PRV  D
  1.  .I $D(^AUPNCPL("APTP",IEN,"G",PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..S @RET@(PRV)=PRV_U_PRVNAME_U_"G"
  1.  ;Care plans
  1.  S PRV="" S PRV=$O(^AUPNCPL("APTP",IEN,"P",PRV)) Q:'+PRV  D
  1.  .I $D(^AUPNCPL("APTP",IEN,"P",PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..I '$D(@RET@(PRV)) D
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_"C"
  1.  ..E  D
  1.  ...S X=$P($G(@RET@(PRV)),U,3)
  1.  ...S X=X_"P"
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_X
  1.  ;Visit Instructions
  1.  S PRV="" F  S PRV=$O(^AUPNVVI("APRV",IEN,PRV)) Q:'+PRV  D
  1.  .I $D(^AUPNVVI("APRV",IEN,PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"V"
  1.  ..E  D
  1.  ...S X=$P($G(@RET@(PRV)),U,3)
  1.  ...S X=X_"V"
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_X
  1.  ;Visit treatments
  1.  S PRV="" F  S PRV=$O(^AUPNVTXR("APRV",IEN,PRV)) Q:'+PRV  D
  1.  .I $D(^AUPNVTXR("APRV",IEN,PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"T"
  1.  ..E  D
  1.  ...S X=$P($G(@RET@(PRV)),U,3)
  1.  ...S X=X_"T"
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_X
  1.  ;Referrals
  1.  S PRV="" F  S PRV=$O(^AUPNVREF("APRV",IEN,PRV)) Q:'+PRV  D
  1.  .I $D(^AUPNVREF("APRV",IEN,PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"R"
  1.  ..E  D
  1.  ...S X=$P($G(@RET@(PRV)),U,3)
  1.  ...S X=X_"R"
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_X
  1.  Q
  1.  ;Consults
  1.  S PRV="" F  S PRV=$O(^GMR(123,"APRV",IEN,PRV)) Q:'+PRV  D
  1.  .I $D(^GMR(123,"APRV",IEN,PRV))>0 D
  1.  ..S PRVNAME=$$GET1^DIQ(200,PRV,.01)
  1.  ..I '$D(@RET@(PRV)) S @RET@(PRV)=PRV_U_PRVNAME_U_"S"
  1.  ..E  D
  1.  ...S X=$P($G(@RET@(PRV)),U,3)
  1.  ...S X=X_"C"
  1.  ...S @RET@(PRV)=PRV_U_PRVNAME_U_X
  1.  ;Education
  1.  Q
  1.  ;Input
  1.  ;DFN of patient
  1.  ;Problem IEN
  1.  ;Provider IEN
  1.  ;Number to return
  1. PRVDATA(DATA,DFN,PROB,PRV,NUM) ;EP return data for a provider
  1.  N CNT
  1.  I $G(NUM)="" S NUM=1
  1.  S CNT=0
  1.  S DATA=$$TMPGBL
  1.  D GET^BGOCPLAN(.DATA,PROB,DFN,"G",NUM,.CNT,PRV)
  1.  D GET^BGOCPLAN(.DATA,PROB,DFN,"P",NUM,.CNT,PRV)
  1.  D GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
  1.  D GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
  1.  D GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,PRV)
  1.  D GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
  1.  D GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"",PRV)
  1.  Q
  1. PROBDATA(DATA,PROB,NUM) ;Get data for one problem
  1.  N CNT,DFN,RETI
  1.  S DATA=$$TMPGBL
  1.  I $G(PROB)="" S @DATA@(1)="-1^Undefined problem" Q
  1.  S DFN=$$GET1^DIQ(9000011,PROB,.02,"I")
  1.  I '+DFN S @DATA@(1)="-1^Unknown patient for this problem" Q
  1.  I $G(NUM)="" S NUM=9999999
  1.  S CNT=0
  1.  S RETI="C"
  1.  D GET^BGOCPLAN(.DATA,PROB,DFN,"G",RETI,.CNT,"")
  1.  D GET^BGOCPLAN(.DATA,PROB,DFN,"P",RETI,.CNT,"")
  1.  D GET^BGOVVI(.DATA,DFN,PROB,NUM,.CNT,"","")
  1.  D GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
  1.  D GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"")
  1.  D GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
  1.  D GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
  1.  Q
  1.  ;EIE can only be done by the author or the chief of MIS
  1.  ;Input = IEN of the entry [1] ^ user deleting [2]
  1. OKDEL(RET,IEN,USER) ;EP  Can this user delete
  1.  N PRV,ENTRYDT,ERR
  1.  S RET=0
  1.  I $G(USER)="" S USER=DUZ
  1.  S PRV=$$GET1^DIQ(9000010.58,IEN,1204,"I")
  1.  I PRV=USER S RET=1 Q
  1.  S ENTRYDT=$$NOW^XLFDT
  1.  S ERR=""
  1.  S RET=$$ISA^TIUPS139(USER,"CHIEF, MIS",ERR)
  1.  Q
  1.  ;Input parameter
  1.  ;INP= Visit instruction ien [1] ^ Reason for eie [2] ^ comment if other [3]
  1. EIE(RET,INP) ;Mark an entry entered in error
  1.  N FNUM,IEN2,FDA,IEN,REASON,CMMT,IENS,RET
  1.  S RET=""
  1.  S IENS=$P(INP,U,1)
  1.  S REASON=$P(INP,U,2)
  1.  S CMMT=$P(INP,U,3)
  1.  S FNUM=9000010.58
  1.  S IEN2=IENS_","
  1.  S FDA=$NA(FDA(FNUM,IEN2))
  1.  S @FDA@(.06)=1
  1.  S @FDA@(.07)=DUZ
  1.  S @FDA@(.08)=$$NOW^XLFDT()
  1.  S @FDA@(.08)=REASON
  1.  S @FDA@(.09)=CMMT
  1.  S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
  1.  Q
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BGOVIN",$J) Q $NA(^($J))
  1.  ; Return file number
  1. FNUM() Q 9000010.58