- BGOVOB ; IHS/BAO/TMD - pull Visit files associated with problems ;31-May-2016 14:36;du
- ;;1.1;BGO COMPONENTS;**21**;Mar 20, 2007;Build 1
- ;---------------------------------------------
- ;Get Data from V OB file
- ;Inp parameters:
- ; DFN
- ; PROB Ien
- ; Number to Return
- ; CNT
- ; SVIEN -visit ien
- ;Return is list of OB notes
- ;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 OB data 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
- .S INVDT="" F S INVDT=$O(^AUPNVOB("AE",DFN,PROB,INVDT)) Q:INVDT=""!(CT+1>NUM) D
- ..S VIN="" F S VIN=$O(^AUPNVOB("AE",DFN,PROB,INVDT,VIN)) Q:'+VIN D
- ...S REC=$G(^AUPNVOB(VIN,0))
- ...Q:REC=""
- ...D GETREC
- ;Find entries for a specific visit
- I SVIEN'="" D
- .S VIN="" F S VIN=$O(^AUPNVOB("AD",SVIEN,VIN)) Q:VIN="" D
- ..S REC=$G(^AUPNVOB(VIN,0))
- ..Q:REC=""
- ..D GETREC
- Q
- GETREC ;Get the record
- S FNUM=$$FNUM
- S PRVIEN=$P($G(^AUPNVOB(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.43,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.43,VIN,1201,"I")
- S SIGN=$$GET1^DIQ(9000010.43,VIN,.05,"I")
- Q:(SIGN="")&(DUZ'=$$GET1^DIQ(9000010.43,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)="O"_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(^AUPNVOB(VIN,11,TXTIEN)) Q:'+TXTIEN D
- .S CNT=CNT+1
- .S @DATA@(CNT)="~t"_U_$TR($G(^AUPNVOB(VIN,11,TXTIEN,0)),$C(13,10))
- Q
- ; Delete a V OB entry
- ;INP=VFIEN ^ DELETE REASON ^ OTHER
- DEL(RET,INP) ;EP
- N COMMENT,FDA,REASON,VFIEN
- S VFIEN=$P(INP,U)
- I $$GET1^DIQ(9000010.43,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 = VOB 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.43,VFIEN_",",1100,,"VAL")
- S RET=VFIEN
- Q ;RET
- ;Mark record when signed
- SIGN(RET,VVOB,BY) ;EP
- N FDA,AIEN,ERR
- S RET="",ERR=""
- I $$GET1^DIQ(9000010.43,VVOB,.05)'="" S RET="-1^Already signed" Q RET
- S AIEN=VVOB_","
- S FDA(9000010.43,AIEN,.04)=BY
- S FDA(9000010.43,AIEN,.05)=$$NOW^XLFDT
- D FILE^DIE("","FDA","ERR")
- I ERR S RET=-1_U_"Unable to sign OB note"
- Q RET
- ;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.43,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.43
- 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
- GETONE(RET,PRIEN) ;Get ALl the data for one problem
- N TYP,NUM,ACT,CPTYP,DFN,CNT,PER,CONCT
- S RET=$$TMPGBL^BGOUTL
- S DFN=$$GET1^DIQ(9000011,PRIEN,.02,"I")
- S TYP="ASEOIR",CPTYP="A",PER="P"
- S NUM=9999999,ACT=1
- S CNT=0
- D GET2^BGOPROB(.RET,PRIEN,DFN,TYP,CPTYP,NUM,ACT,PER,2)
- 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^BGOVOB(.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
- TMPGBL(X) ;EP
- K ^TMP("BGOVOB",$J) Q $NA(^($J))
- ; Return file number
- FNUM() Q 9000010.43
- BGOVOB ; IHS/BAO/TMD - pull Visit files associated with problems ;31-May-2016 14:36;du
- +1 ;;1.1;BGO COMPONENTS;**21**;Mar 20, 2007;Build 1
- +2 ;---------------------------------------------
- +3 ;Get Data from V OB file
- +4 ;Inp parameters:
- +5 ; DFN
- +6 ; PROB Ien
- +7 ; Number to Return
- +8 ; CNT
- +9 ; SVIEN -visit ien
- +10 ;Return is list of OB notes
- +11 ;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]
- +12 ; =~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 OB data 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 SET INVDT=""
- FOR
- SET INVDT=$ORDER(^AUPNVOB("AE",DFN,PROB,INVDT))
- IF INVDT=""!(CT+1>NUM)
- QUIT
- Begin DoDot:2
- +13 SET VIN=""
- FOR
- SET VIN=$ORDER(^AUPNVOB("AE",DFN,PROB,INVDT,VIN))
- IF '+VIN
- QUIT
- Begin DoDot:3
- +14 SET REC=$GET(^AUPNVOB(VIN,0))
- +15 IF REC=""
- QUIT
- +16 DO GETREC
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 ;Find entries for a specific visit
- +18 IF SVIEN'=""
- Begin DoDot:1
- +19 SET VIN=""
- FOR
- SET VIN=$ORDER(^AUPNVOB("AD",SVIEN,VIN))
- IF VIN=""
- QUIT
- Begin DoDot:2
- +20 SET REC=$GET(^AUPNVOB(VIN,0))
- +21 IF REC=""
- QUIT
- +22 DO GETREC
- End DoDot:2
- End DoDot:1
- +23 QUIT
- GETREC ;Get the record
- +1 SET FNUM=$$FNUM
- +2 SET PRVIEN=$PIECE($GET(^AUPNVOB(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.43,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.43,VIN,1201,"I")
- +15 SET SIGN=$$GET1^DIQ(9000010.43,VIN,.05,"I")
- +16 IF (SIGN="")&(DUZ'=$$GET1^DIQ(9000010.43,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)="O"_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(^AUPNVOB(VIN,11,TXTIEN))
- IF '+TXTIEN
- QUIT
- Begin DoDot:1
- +24 SET CNT=CNT+1
- +25 SET @DATA@(CNT)="~t"_U_$TRANSLATE($GET(^AUPNVOB(VIN,11,TXTIEN,0)),$CHAR(13,10))
- End DoDot:1
- +26 QUIT
- +27 ; Delete a V OB entry
- +28 ;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.43,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 = VOB 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.43,VFIEN_",",1100,,"VAL")
- +37 SET RET=VFIEN
- +38 ;RET
- QUIT
- +39 ;Mark record when signed
- SIGN(RET,VVOB,BY) ;EP
- +1 NEW FDA,AIEN,ERR
- +2 SET RET=""
- SET ERR=""
- +3 IF $$GET1^DIQ(9000010.43,VVOB,.05)'=""
- SET RET="-1^Already signed"
- QUIT RET
- +4 SET AIEN=VVOB_","
- +5 SET FDA(9000010.43,AIEN,.04)=BY
- +6 SET FDA(9000010.43,AIEN,.05)=$$NOW^XLFDT
- +7 DO FILE^DIE("","FDA","ERR")
- +8 IF ERR
- SET RET=-1_U_"Unable to sign OB note"
- +9 QUIT RET
- +10 ;EIE can only be done by the author or the chief of MIS
- +11 ;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.43,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.43
- +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
- GETONE(RET,PRIEN) ;Get ALl the data for one problem
- +1 NEW TYP,NUM,ACT,CPTYP,DFN,CNT,PER,CONCT
- +2 SET RET=$$TMPGBL^BGOUTL
- +3 SET DFN=$$GET1^DIQ(9000011,PRIEN,.02,"I")
- +4 SET TYP="ASEOIR"
- SET CPTYP="A"
- SET PER="P"
- +5 SET NUM=9999999
- SET ACT=1
- +6 SET CNT=0
- +7 DO GET2^BGOPROB(.RET,PRIEN,DFN,TYP,CPTYP,NUM,ACT,PER,2)
- +8 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^BGOVOB(.DATA,DFN,PROB,NUM,.CNT,"","")
- +13 DO GET^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
- +14 DO GETCON^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"")
- +15 DO GETREF^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
- +16 DO GETEDU^BGOVTR(.DATA,DFN,PROB,NUM,.CNT,"","")
- +17 QUIT
- TMPGBL(X) ;EP
- +1 KILL ^TMP("BGOVOB",$JOB)
- QUIT $NAME(^($JOB))
- +2 ; Return file number
- FNUM() QUIT 9000010.43