BGOICDP2 ; IHS/BAO/TMD - ICD PREFERENCES MANAGER 2 ;20-Mar-2007 13:52;DKM
;;1.1;BGO COMPONENTS;**1,3**;Mar 20, 2007
; Clone ICD preferences from PCC
; INP = Provider IEN ^ ICD Preference IEN
CLONEOTH(RET,INP) ;EP
N PRV,CAT,PIEN,ICD,TXT
S RET=""
S PRV=+INP
I 'PRV S RET=$$ERR^BGOUTL(1027) Q
I '$D(^VEN(7.1,"B",PRV)) S RET=$$ERR^BGOUTL(1028) Q
S CAT=$P(INP,U,2)
I 'CAT S RET=$$ERR^BGOUTL(1018) Q
I '$D(^BGOICDPR(CAT,0)) S RET=$$ERR^BGOUTL(1019) Q
S PIEN=0
F S PIEN=$O(^VEN(7.1,"B",PRV,PIEN)) Q:'PIEN D Q:RET
.S ICD=$P(^VEN(7.1,PIEN,0),U,2)
.Q:ICD=""
.S ICD=$O(^ICD9("AB",ICD,0))
.Q:'ICD
.Q:$O(^BGOICDPR(CAT,1,"B",ICD,0))
.S TXT=$P(^VEN(7.1,PIEN,0),U,3)
.S RET=$$UPDITEM^BGOPFUTL(90362.35,CAT,ICD,0,TXT)
Q
; Clone a preference
; INP = Pref IEN (from) ^ Pref IEN (to)
CLONE(RET,INP) ;EP
D CLONE^BGOPFUTL(.RET,INP,90362.35)
Q
; Return list of PCC+ provider names
; Returned as a list of records of the format:
; Provider Name ^ Provider IEN
OTHCATS(RET,DUMMY) ;EP
N PRV,CNT
S (PRV,CNT)=0
F S PRV=$O(^VEN(7.1,"B",PRV)) Q:'PRV D
.S:$D(^VA(200,PRV,0)) CNT=CNT+1,RET(CNT)=$P(^(0),U)_U_PRV
Q
; Execute query
; INP = Category IEN [1] ^ Provider IEN [2] ^ Clinic IEN [3] ^ Provider Class [4] ^ Hospital Location [5] ^
; Start Date [6] ^ End Date [7] ^ Max Hits [8]
QUERY(RET,INP) ;EP
N CAT,PRV,CLN,CLS,HL,BEGDT,ENDDT,VD,VIEN,VIS,PIEN,DX,ICD,REC,ICD,TXT,CNT,MAX,X
S RET=""
S CAT=$P(INP,U)
S PRV=$P(INP,U,2)
S CLN=$P(INP,U,3)
S CLS=$P(INP,U,4)
S HL=$P(INP,U,5)
S BEGDT=$P(INP,U,6)
S ENDDT=$P(INP,U,7)
S MAX=+$P(INP,U,8)
I CLN="",CLS="",PRV="",HL="" S RET=$$ERR^BGOUTL(1022) Q
S RET=$$QRYINIT^BGOPFUTL(90362.35,CAT)
Q:RET
S VD=$S(BEGDT:BEGDT,1:DT-20000)
S:'ENDDT ENDDT=DT
S CNT=0
F S VD=$O(^AUPNVSIT("B",VD)) Q:'VD!RET!(VD>ENDDT) D
.S VIEN=0
.F S VIEN=$O(^AUPNVSIT("B",VD,VIEN)) Q:'VIEN!RET D
..S VIS=$G(^AUPNVSIT(VIEN,0))
..Q:VIS=""
..I CLN,$P(VIS,U,8)'=CLN Q
..I HL,$P(VIS,U,22)'=HL Q
..I PRV!CLS,'$$VISPRCL^BGOPFUTL(VIEN,PRV,CLS) Q
..S DX=0
..F S DX=$O(^AUPNVPOV("AD",VIEN,DX)) Q:'DX!RET D
...S CNT=CNT+1
...S:CNT=MAX RET=CNT
...S REC=^AUPNVPOV(DX,0)
...S ICD=+REC
...S TXT=$P($G(^AUTNPOV(+$P(REC,U,4),0)),U)
...D QRYADD^BGOPFUTL(90362.35,CAT,ICD,TXT)
S RET=$$QRYDONE^BGOPFUTL(90362.35,CAT)
Q
BGOICDP2 ; IHS/BAO/TMD - ICD PREFERENCES MANAGER 2 ;20-Mar-2007 13:52;DKM
+1 ;;1.1;BGO COMPONENTS;**1,3**;Mar 20, 2007
+2 ; Clone ICD preferences from PCC
+3 ; INP = Provider IEN ^ ICD Preference IEN
CLONEOTH(RET,INP) ;EP
+1 NEW PRV,CAT,PIEN,ICD,TXT
+2 SET RET=""
+3 SET PRV=+INP
+4 IF 'PRV
SET RET=$$ERR^BGOUTL(1027)
QUIT
+5 IF '$DATA(^VEN(7.1,"B",PRV))
SET RET=$$ERR^BGOUTL(1028)
QUIT
+6 SET CAT=$PIECE(INP,U,2)
+7 IF 'CAT
SET RET=$$ERR^BGOUTL(1018)
QUIT
+8 IF '$DATA(^BGOICDPR(CAT,0))
SET RET=$$ERR^BGOUTL(1019)
QUIT
+9 SET PIEN=0
+10 FOR
SET PIEN=$ORDER(^VEN(7.1,"B",PRV,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+11 SET ICD=$PIECE(^VEN(7.1,PIEN,0),U,2)
+12 IF ICD=""
QUIT
+13 SET ICD=$ORDER(^ICD9("AB",ICD,0))
+14 IF 'ICD
QUIT
+15 IF $ORDER(^BGOICDPR(CAT,1,"B",ICD,0))
QUIT
+16 SET TXT=$PIECE(^VEN(7.1,PIEN,0),U,3)
+17 SET RET=$$UPDITEM^BGOPFUTL(90362.35,CAT,ICD,0,TXT)
End DoDot:1
IF RET
QUIT
+18 QUIT
+19 ; Clone a preference
+20 ; INP = Pref IEN (from) ^ Pref IEN (to)
CLONE(RET,INP) ;EP
+1 DO CLONE^BGOPFUTL(.RET,INP,90362.35)
+2 QUIT
+3 ; Return list of PCC+ provider names
+4 ; Returned as a list of records of the format:
+5 ; Provider Name ^ Provider IEN
OTHCATS(RET,DUMMY) ;EP
+1 NEW PRV,CNT
+2 SET (PRV,CNT)=0
+3 FOR
SET PRV=$ORDER(^VEN(7.1,"B",PRV))
IF 'PRV
QUIT
Begin DoDot:1
+4 IF $DATA(^VA(200,PRV,0))
SET CNT=CNT+1
SET RET(CNT)=$PIECE(^(0),U)_U_PRV
End DoDot:1
+5 QUIT
+6 ; Execute query
+7 ; INP = Category IEN [1] ^ Provider IEN [2] ^ Clinic IEN [3] ^ Provider Class [4] ^ Hospital Location [5] ^
+8 ; Start Date [6] ^ End Date [7] ^ Max Hits [8]
QUERY(RET,INP) ;EP
+1 NEW CAT,PRV,CLN,CLS,HL,BEGDT,ENDDT,VD,VIEN,VIS,PIEN,DX,ICD,REC,ICD,TXT,CNT,MAX,X
+2 SET RET=""
+3 SET CAT=$PIECE(INP,U)
+4 SET PRV=$PIECE(INP,U,2)
+5 SET CLN=$PIECE(INP,U,3)
+6 SET CLS=$PIECE(INP,U,4)
+7 SET HL=$PIECE(INP,U,5)
+8 SET BEGDT=$PIECE(INP,U,6)
+9 SET ENDDT=$PIECE(INP,U,7)
+10 SET MAX=+$PIECE(INP,U,8)
+11 IF CLN=""
IF CLS=""
IF PRV=""
IF HL=""
SET RET=$$ERR^BGOUTL(1022)
QUIT
+12 SET RET=$$QRYINIT^BGOPFUTL(90362.35,CAT)
+13 IF RET
QUIT
+14 SET VD=$SELECT(BEGDT:BEGDT,1:DT-20000)
+15 IF 'ENDDT
SET ENDDT=DT
+16 SET CNT=0
+17 FOR
SET VD=$ORDER(^AUPNVSIT("B",VD))
IF 'VD!RET!(VD>ENDDT)
QUIT
Begin DoDot:1
+18 SET VIEN=0
+19 FOR
SET VIEN=$ORDER(^AUPNVSIT("B",VD,VIEN))
IF 'VIEN!RET
QUIT
Begin DoDot:2
+20 SET VIS=$GET(^AUPNVSIT(VIEN,0))
+21 IF VIS=""
QUIT
+22 IF CLN
IF $PIECE(VIS,U,8)'=CLN
QUIT
+23 IF HL
IF $PIECE(VIS,U,22)'=HL
QUIT
+24 IF PRV!CLS
IF '$$VISPRCL^BGOPFUTL(VIEN,PRV,CLS)
QUIT
+25 SET DX=0
+26 FOR
SET DX=$ORDER(^AUPNVPOV("AD",VIEN,DX))
IF 'DX!RET
QUIT
Begin DoDot:3
+27 SET CNT=CNT+1
+28 IF CNT=MAX
SET RET=CNT
+29 SET REC=^AUPNVPOV(DX,0)
+30 SET ICD=+REC
+31 SET TXT=$PIECE($GET(^AUTNPOV(+$PIECE(REC,U,4),0)),U)
+32 DO QRYADD^BGOPFUTL(90362.35,CAT,ICD,TXT)
End DoDot:3
End DoDot:2
End DoDot:1
+33 SET RET=$$QRYDONE^BGOPFUTL(90362.35,CAT)
+34 QUIT
