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
