BGOEDTP2.m

BGOEDTP2 ; IHS/BAO/TMD - EDUCATION TOPIC PREFERENCES MANAGER 2 ;18-Sep-2007 14:42;DKM

 ;;1.1;BGO COMPONENTS;**1,3,4**;Mar 20, 2007

 ; Clone a preference

 ;  INP = Pref IEN (from) ^ Pref IEN (to)

CLONE(RET,INP) ;EP

 D CLONE^BGOPFUTL(.RET,INP,90362.36)

 Q

 ; Execute query to update frequencies

 ;  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,DX,EDT,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.36,CAT)

 Q:RET

 S VD=$S(BEGDT:BEGDT,1:DT-20000)

 S:'ENDDT ENDDT=DT

 S CNT=0,ENDDT=ENDDT\1+.9

 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(^AUPNVPED("AD",VIEN,DX)) Q:'DX!RET  D

 ...S CNT=CNT+1

 ...S:CNT=MAX RET=CNT

 ...S EDT=+$G(^AUPNVPED(DX,0))

 ...Q:'EDT

 ...S TXT=$P($G(^AUTTEDT(EDT,0)),U)

 ...D QRYADD^BGOPFUTL(90362.36,CAT,EDT,TXT)

 S RET=$$QRYDONE^BGOPFUTL(90362.36,CAT)

 Q

BGOEDTP2  ; IHS/BAO/TMD - EDUCATION TOPIC PREFERENCES MANAGER 2 ;18-Sep-2007 14:42;DKM

 +1       ;;1.1;BGO COMPONENTS;**1,3,4**;Mar 20, 2007

 +2       ; Clone a preference

 +3       ;  INP = Pref IEN (from) ^ Pref IEN (to)

CLONE(RET,INP) ;EP

 +1        DO CLONE^BGOPFUTL(.RET,INP,90362.36)

 +2        QUIT 

 +3       ; Execute query to update frequencies

 +4       ;  INP = Category IEN [1] ^ Provider IEN [2] ^ Clinic IEN [3] ^ Provider Class [4] ^ Hospital Location [5] ^

 +5       ;        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,DX,EDT,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.36,CAT)

 +13       IF RET

               QUIT 

 +14       SET VD=$SELECT(BEGDT:BEGDT,1:DT-20000)

 +15       IF 'ENDDT

               SET ENDDT=DT

 +16       SET CNT=0

           SET ENDDT=ENDDT\1+.9

 +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(^AUPNVPED("AD",VIEN,DX))

                               IF 'DX!RET

                                   QUIT 

                               Begin DoDot:3

 +27                               SET CNT=CNT+1

 +28                               IF CNT=MAX

                                       SET RET=CNT

 +29                               SET EDT=+$GET(^AUPNVPED(DX,0))

 +30                               IF 'EDT

                                       QUIT 

 +31                               SET TXT=$PIECE($GET(^AUTTEDT(EDT,0)),U)

 +32                               DO QRYADD^BGOPFUTL(90362.36,CAT,EDT,TXT)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33       SET RET=$$QRYDONE^BGOPFUTL(90362.36,CAT)

 +34       QUIT