- 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
