BEHORXEI.m

BEHORXEI ;MSC/IND/PLS - PharmED Component KIDS Support ;25-Jun-2014 12:28;PLS

 ;;1.1;BEH COMPONENTS;**044002,044003,044005**;Mar 20, 2007

 ;=========================================================

PREINIT ;EP - Preinitialization

 N ERR

 ;D FIXNAR

 ;D FIXTOPIC

 D LOCK("BEHORXED POV SNOMED LIST",0)

 D NDEL^XPAR("SYS","BEHORXED POV SNOMED LIST",.ERR) ;Purge existing values

 Q

POSTINIT ;EP - Postinitialization

 N OPT

 F OPT="BEHORXED DEFAULT POV","BEHORXED POV LIST","BEHORXED POV NARR TEXT" D OUT^XPDMENU(OPT,"Not currently used."),UPDPAR("SYS",OPT)

 D REGMENU^BEHUTIL("BEHORXED POV SNOMED LIST",,"SNM","BEHORXED MAIN")

 D REGMENU^BEHUTIL("BEHORXED POV MAP ICD",,"PMI","BEHORXED MAIN")

 D LOCK("BEHORXED POV SNOMED LIST",1)

 Q

 ; old logic below

 N LST,ITM,INST,LP

 S INST=0

 F LP="V65.49 ","V65.19 " D

 .S ITM=$$FIND1^DIC(80,,,LP,"BA")

 .I ITM D

 ..S INST=INST+1

 ..S LST(INST)="`"_ITM

 D:$D(LST) SETPAR("BEHORXED POV LIST",.LST)

 D REGNMSP^CIAURPC("BEHORXED","CIAV VUECENTRIC")

 D REGMENU^BEHUTIL("BEHORXED MAIN",,"MEC","BEHORX MAIN")

 D EDITPAR^XPAREDIT("BEHORXED DEF HOSP LOCATION")

 Q

 ; Fix bad narrative entries

FIXNAR N NAR,POV,LP,DAT,VIEN,VPOV,CNT

 F LP="DIV","SYS" D

 .N TMP,IEN,IEN2,I

 .D GETLST^XPAR(.TMP,LP,"BEHORXED POV LIST","I")

 .F I=0:0 S I=$O(TMP(I)) Q:'I  S POV(+TMP(I))=""

 .K TMP

 .D GETLST^XPAR(.TMP,LP,"BEHORXED POV NARR TEXT","I")

 .F I=0:0 S I=$O(TMP(I)) Q:'I  D

 ..S NAR=TMP(I),IEN=0

 ..Q:'$L(NAR)

 ..F  S IEN=$$FNDNAR(NAR,IEN) Q:'IEN  D

 ...S IEN2=$$FNDNAR(IEN,0)

 ...S:IEN2 NAR(IEN2)=IEN

 Q:$D(NAR)<10

 D BMES^XPDUTL("Searching for bad med counseling VPOV entries...")

 S DAT=3070600,CNT=0

 F  S DAT=$O(^AUPNVSIT("B",DAT)) Q:'DAT  D

 .F VIEN=0:0 S VIEN=$O(^AUPNVSIT("B",DAT,VIEN)) Q:'VIEN  D

 ..F VPOV=0:0 S VPOV=$O(^AUPNVPOV("AD",VIEN,VPOV)) Q:'VPOV  D

 ...N X

 ...S X=$G(^AUPNVPOV(VPOV,0))

 ...Q:'$D(POV(+X))

 ...S NAR=+$P(X,U,4)

 ...Q:'$D(NAR(NAR))

 ...S $P(^AUPNVPOV(VPOV,0),U,4)=NAR(NAR),CNT=CNT+1

 ...D MES("Repaired VPOV record #"_VPOV)

 D MES("Bad entries detected and repaired: "_CNT)

 Q

 ; Find next narrative entry

FNDNAR(NAR,IEN) ;

 N TRC

 S TRC=$E(NAR,1,30)

 F  S IEN=$O(^AUTNPOV("B",TRC,IEN)) Q:'IEN  Q:$P($G(^AUTNPOV(IEN,0)),U)=NAR

 Q IEN

 ; Build parameter values

SETPAR(PARAM,ARY) ;EP

 N ENT,VAL,INST

 D MES("Setting up default site parameters...")

 S INST=0 F  S INST=$O(ARY(INST)) Q:'INST  S VAL=ARY(INST) D

 .S ENT=$$ENT^CIAVMRPC(PARAM),ENT=$P(ENT,U,$L(ENT,U))

 .D:$L(ENT) ADD^XPAR(ENT,PARAM,INST,.VAL)

 Q

 ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ; EP

 D BMES^XPDUTL("  "_$G(MSG))

 S:$G(QUIT) XPDQUIT=QUIT

 Q

 ; Fix bad Education Topic entries

FIXTOPIC ; EP -

 N VIEN,DAT,CNT,VPED,TOP

 D BMES^XPDUTL("Searching for bad med counselling VPOV entries...")

 S DAT=3070600,CNT=0

 F  S DAT=$O(^AUPNVSIT("B",DAT)) Q:'DAT  D

 .F VIEN=0:0 S VIEN=$O(^AUPNVSIT("B",DAT,VIEN)) Q:'VIEN  D

 ..F VPED=0:0 S VPED=$O(^AUPNVPED("AD",VIEN,VPED)) Q:'VPED  D

 ...N X

 ...S X=$G(^AUPNVPED(VPED,0))

 ...Q:$P(X,U,12)'="MEDICATIONS"

 ...S $P(^AUPNVPED(VPED,0),U,12)=$$PEDTOPIC^BEHOENPC("MEDICATIONS"),CNT=CNT+1

 ...D MES("Repaired VPED record #"_VPED)

 D MES("Bad entries detected and repaired: "_CNT)

 Q

UPDPAR(ENT,PARAM,VAL) ;EP-

 N IEN

 S IEN=$O(^XTV(8989.51,"B",PARAM,0))

 Q:'IEN

 S $P(^XTV(8989.51,IEN,0),U,6)=0

 D:$G(VAL)'="" EN^XPAR(ENT,PARAM,,VAL)

 S $P(^XTV(8989.51,IEN,0),U,6)=1

 Q

 ;Set prohibit editing field of parameter

LOCK(PARAM,VAL) ;EP-

 N IEN

 S IEN=$O(^XTV(8989.51,"B",PARAM,0))

 Q:'IEN

 S $P(^XTV(8989.51,IEN,0),U,6)=VAL

 Q

BEHORXEI  ;MSC/IND/PLS - PharmED Component KIDS Support ;25-Jun-2014 12:28;PLS

 +1       ;;1.1;BEH COMPONENTS;**044002,044003,044005**;Mar 20, 2007

 +2       ;=========================================================

PREINIT   ;EP - Preinitialization

 +1        NEW ERR

 +2       ;D FIXNAR

 +3       ;D FIXTOPIC

 +4        DO LOCK("BEHORXED POV SNOMED LIST",0)

 +5       ;Purge existing values

           DO NDEL^XPAR("SYS","BEHORXED POV SNOMED LIST",.ERR)

 +6        QUIT 

POSTINIT  ;EP - Postinitialization

 +1        NEW OPT

 +2        FOR OPT="BEHORXED DEFAULT POV","BEHORXED POV LIST","BEHORXED POV NARR TEXT"

               DO OUT^XPDMENU(OPT,"Not currently used.")

               DO UPDPAR("SYS",OPT)

 +3        DO REGMENU^BEHUTIL("BEHORXED POV SNOMED LIST",,"SNM","BEHORXED MAIN")

 +4        DO REGMENU^BEHUTIL("BEHORXED POV MAP ICD",,"PMI","BEHORXED MAIN")

 +5        DO LOCK("BEHORXED POV SNOMED LIST",1)

 +6        QUIT 

 +7       ; old logic below

 +8        NEW LST,ITM,INST,LP

 +9        SET INST=0

 +10       FOR LP="V65.49 ","V65.19 "

               Begin DoDot:1

 +11               SET ITM=$$FIND1^DIC(80,,,LP,"BA")

 +12               IF ITM

                       Begin DoDot:2

 +13                       SET INST=INST+1

 +14                       SET LST(INST)="`"_ITM

                       End DoDot:2

               End DoDot:1

 +15       IF $DATA(LST)

               DO SETPAR("BEHORXED POV LIST",.LST)

 +16       DO REGNMSP^CIAURPC("BEHORXED","CIAV VUECENTRIC")

 +17       DO REGMENU^BEHUTIL("BEHORXED MAIN",,"MEC","BEHORX MAIN")

 +18       DO EDITPAR^XPAREDIT("BEHORXED DEF HOSP LOCATION")

 +19       QUIT 

 +20      ; Fix bad narrative entries

FIXNAR     NEW NAR,POV,LP,DAT,VIEN,VPOV,CNT

 +1        FOR LP="DIV","SYS"

               Begin DoDot:1

 +2                NEW TMP,IEN,IEN2,I

 +3                DO GETLST^XPAR(.TMP,LP,"BEHORXED POV LIST","I")

 +4                FOR I=0:0

                       SET I=$ORDER(TMP(I))

                       IF 'I

                           QUIT 

                       SET POV(+TMP(I))=""

 +5                KILL TMP

 +6                DO GETLST^XPAR(.TMP,LP,"BEHORXED POV NARR TEXT","I")

 +7                FOR I=0:0

                       SET I=$ORDER(TMP(I))

                       IF 'I

                           QUIT 

                       Begin DoDot:2

 +8                        SET NAR=TMP(I)

                           SET IEN=0

 +9                        IF '$LENGTH(NAR)

                               QUIT 

 +10                       FOR 

                               SET IEN=$$FNDNAR(NAR,IEN)

                               IF 'IEN

                                   QUIT 

                               Begin DoDot:3

 +11                               SET IEN2=$$FNDNAR(IEN,0)

 +12                               IF IEN2

                                       SET NAR(IEN2)=IEN

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       IF $DATA(NAR)<10

               QUIT 

 +14       DO BMES^XPDUTL("Searching for bad med counseling VPOV entries...")

 +15       SET DAT=3070600

           SET CNT=0

 +16       FOR 

               SET DAT=$ORDER(^AUPNVSIT("B",DAT))

               IF 'DAT

                   QUIT 

               Begin DoDot:1

 +17               FOR VIEN=0:0

                       SET VIEN=$ORDER(^AUPNVSIT("B",DAT,VIEN))

                       IF 'VIEN

                           QUIT 

                       Begin DoDot:2

 +18                       FOR VPOV=0:0

                               SET VPOV=$ORDER(^AUPNVPOV("AD",VIEN,VPOV))

                               IF 'VPOV

                                   QUIT 

                               Begin DoDot:3

 +19                               NEW X

 +20                               SET X=$GET(^AUPNVPOV(VPOV,0))

 +21                               IF '$DATA(POV(+X))

                                       QUIT 

 +22                               SET NAR=+$PIECE(X,U,4)

 +23                               IF '$DATA(NAR(NAR))

                                       QUIT 

 +24                               SET $PIECE(^AUPNVPOV(VPOV,0),U,4)=NAR(NAR)

                                   SET CNT=CNT+1

 +25                               DO MES("Repaired VPOV record #"_VPOV)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +26       DO MES("Bad entries detected and repaired: "_CNT)

 +27       QUIT 

 +28      ; Find next narrative entry

FNDNAR(NAR,IEN) ;

 +1        NEW TRC

 +2        SET TRC=$EXTRACT(NAR,1,30)

 +3        FOR 

               SET IEN=$ORDER(^AUTNPOV("B",TRC,IEN))

               IF 'IEN

                   QUIT 

               IF $PIECE($GET(^AUTNPOV(IEN,0)),U)=NAR

                   QUIT 

 +4        QUIT IEN

 +5       ; Build parameter values

SETPAR(PARAM,ARY) ;EP

 +1        NEW ENT,VAL,INST

 +2        DO MES("Setting up default site parameters...")

 +3        SET INST=0

           FOR 

               SET INST=$ORDER(ARY(INST))

               IF 'INST

                   QUIT 

               SET VAL=ARY(INST)

               Begin DoDot:1

 +4                SET ENT=$$ENT^CIAVMRPC(PARAM)

                   SET ENT=$PIECE(ENT,U,$LENGTH(ENT,U))

 +5                IF $LENGTH(ENT)

                       DO ADD^XPAR(ENT,PARAM,INST,.VAL)

               End DoDot:1

 +6        QUIT 

 +7       ; Display message in MSG and optionally set quit flag to QUIT

MES(MSG,QUIT) ; EP

 +1        DO BMES^XPDUTL("  "_$GET(MSG))

 +2        IF $GET(QUIT)

               SET XPDQUIT=QUIT

 +3        QUIT 

 +4       ; Fix bad Education Topic entries

FIXTOPIC  ; EP -

 +1        NEW VIEN,DAT,CNT,VPED,TOP

 +2        DO BMES^XPDUTL("Searching for bad med counselling VPOV entries...")

 +3        SET DAT=3070600

           SET CNT=0

 +4        FOR 

               SET DAT=$ORDER(^AUPNVSIT("B",DAT))

               IF 'DAT

                   QUIT 

               Begin DoDot:1

 +5                FOR VIEN=0:0

                       SET VIEN=$ORDER(^AUPNVSIT("B",DAT,VIEN))

                       IF 'VIEN

                           QUIT 

                       Begin DoDot:2

 +6                        FOR VPED=0:0

                               SET VPED=$ORDER(^AUPNVPED("AD",VIEN,VPED))

                               IF 'VPED

                                   QUIT 

                               Begin DoDot:3

 +7                                NEW X

 +8                                SET X=$GET(^AUPNVPED(VPED,0))

 +9                                IF $PIECE(X,U,12)'="MEDICATIONS"

                                       QUIT 

 +10                               SET $PIECE(^AUPNVPED(VPED,0),U,12)=$$PEDTOPIC^BEHOENPC("MEDICATIONS")

                                   SET CNT=CNT+1

 +11                               DO MES("Repaired VPED record #"_VPED)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       DO MES("Bad entries detected and repaired: "_CNT)

 +13       QUIT 

UPDPAR(ENT,PARAM,VAL) ;EP-

 +1        NEW IEN

 +2        SET IEN=$ORDER(^XTV(8989.51,"B",PARAM,0))

 +3        IF 'IEN

               QUIT 

 +4        SET $PIECE(^XTV(8989.51,IEN,0),U,6)=0

 +5        IF $GET(VAL)'=""

               DO EN^XPAR(ENT,PARAM,,VAL)

 +6        SET $PIECE(^XTV(8989.51,IEN,0),U,6)=1

 +7        QUIT 

 +8       ;Set prohibit editing field of parameter

LOCK(PARAM,VAL) ;EP-

 +1        NEW IEN

 +2        SET IEN=$ORDER(^XTV(8989.51,"B",PARAM,0))

 +3        IF 'IEN

               QUIT 

 +4        SET $PIECE(^XTV(8989.51,IEN,0),U,6)=VAL

 +5        QUIT