VENPCCKD ; IHS/OIT/GIS - GUI TRANSACTION MANAGER - DEVEL/AUTISM SCREENING COMMENTS ;
;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
;
;
;
FLUSH(VIEN) ; EP - FLUSH RESULTS FROM TX TABLE TO V WELL CHILD AND CLEAN UP
S OUT=""
I '$D(^AUPNVSIT(+$G(VIEN),0)) Q
N TYPE,KEY,DIK,DIC,X,Y,Z,%,TXIEN,DFN
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I '$D(^DPT(+DFN,0)) Q
S KEY=VIEN_"_2",DIK="^VEN(7.16,",DA=0
F S DA=$O(^VEN(7.16,"AC",KEY,DA)) Q:'DA D ^DIK ; CLEAN OUT DEVEL BENCHMARKS FROM TX FILE
S KEY=VIEN_"_9",TXIEN=0
F S TXIEN=$O(^VEN(7.16,"AC",KEY,TXIEN)) Q:'TXIEN D DF(TXIEN,DFN,VIEN) ; PROCESS EVERY TX
S DIK="^VEN(7.16,",DA=0
F S DA=$O(^VEN(7.16,"AC",KEY,DA)) Q:'DA D ^DIK ; CLEAN OUT DEVEL COMMENTS FROM TX FILE
D ^XBFMK
Q
;
DF(TXIEN,DFN,VIEN) ; EP - CREATE THE V WELL CHILD ENTRIES
N STG,X,Y,Z,%,DIC,DIE,DR,DA,GBL,COM,RES,CAT,FLD,SS,PCE,VWCIEN
S STG=$G(^VEN(7.16,+$G(TXIEN),0)) I '$L(STG) Q
S VWCIEN=$$VWC^VENPCCQC(DFN,VIEN) I '$D(^AUPNVWC(+VWCIEN,0)) Q
S GBL=$NA(^AUPNVWC(VWCIEN))
S CAT=$P(STG,U,2) I '$L(CAT) Q
S FLD=$S(CAT["FINE":3.01,CAT["GROSS":3.02,CAT["LANGU":3.03,CAT["SOCIAL":3.04,CAT["AUTISM":9.01,1:"") I 'FLD Q
S SS=FLD\1,PCE=+$P(FLD,".",2)
I $D(@GBL@(SS)) S $P(@GBL@(SS),U,PCE)="" ; CLEAN OUT PREVIOUS RESULTS FOR THIS CATEGORY
S RES=$P(STG,U,7),COM=$P($G(^VEN(7.16,TXIEN,1)),U,2) I RES="",COM="" Q
S X="",RES=$S(RES="N":"NORMAL",RES="B":"BORDERLINE",RES="A":"ABNORMAL",1:"")
I $L(RES),$L(COM) S X=RES_": "_COM
I X="",$L(RES) S X=RES
I X="" S X=COM
S X=$E(X,1,60)
I X="NORMAL: OK" S X="NORMAL"
S $P(@GBL@(SS),U,PCE)=X
S OUT="OK"
Q
;
POP(IN) ; EP - POPULATE THE TX TABLE WITH DEVEL ASSESSMENT INFO
; 2 SETS OF ITEMS NEED TO BE POPULATED: BENCHMARKS AND RESULTS. THESE WILL BE COMBINED INTO ONE GUI TABLE
N LINE,ARR,VIEN,DFN,TYPE,KEY,DA,DIK,CAT,CNT,FLD,STOP,DIC,X,Y,Z,%
D VAR^VENPCCKT I '$D(LINE) Q
DEV S (LINE,CNT)=0
DEV1 I LINE="" G DEV2
S STOP=0
F S LINE=$O(LINE(LINE)) Q:'LINE D I STOP Q ; GET STARTING LINE FOR EXAM SUBCATEGORY
. S CAT=""
. I LINE(LINE)["FINE MOTOR (%" S STOP=1,CAT="FINE MOTOR",FLD=3.01 Q
. I LINE(LINE)["GROSS MOTOR (%" S STOP=1,CAT="GROSS MOTOR",FLD=3.02 Q
. I LINE(LINE)["LANGUAGE (%" S STOP=1,CAT="LANGUAGE",FLD=3.03 Q
. I LINE(LINE)["SOCIAL (%" S STOP=1,CAT="SOCIAL",FLD=3.04 Q
. I LINE(LINE)="AUTISM SCREEN" S STOP=1,CAT="AUTISM SCREEN",FLD=9.01 Q
. Q
DEV2 I 'LINE!(CAT="") D Q ; QUIT IF NO MORE DEVEL ITEMS EXIST
. I CNT S OUT="BMX ADO SS^VEN WCM TX^^AC~"_KEY_"~"_KEY_"~9999"
. D ^XBFMK
. Q
S CAT="WCDA DEVEL "_CAT
I TYPE=2 D BENCH(.LINE,.CNT,CAT,KEY) G DEV1 ; ADD BENCHMARKS TO TX FILE
K ARR
D LAST(DFN,FLD,.ARR) ; BUILD LAST COMMENTS ARRAY
D TODAY(DFN,FLD,.ARR) ; GET TODAYS RESULTS
I $D(ARR) D COM(.ARR,.CNT,CAT,FLD,KEY) ; ADD DEVEL COMMENTS TO TX FILE
G DEV1 ; PROCESS ANOTHER DEV CATEGORY
;
COM(ARR,CNT,CAT,FLD,KEY) ; EP - UPDATE THE TX FILE WITH DEVEL COMMENTS
N DIC,DA,CIEN,X,Y,%,GBLLAST,LCOM,COM,RES,LAST,VWCIEN,GBL
COM1 S CIEN=$O(^VEN(7.11,"B",CAT,0)) I 'CIEN Q
S (LAST,LCOM)=""
S X=$G(ARR("LAST")) I '$L(X) G COM2
S Y=$P(X,U,2)
I Y S LAST=$$FMTE^XLFDT(Y,"1D")
I $L(LAST) S LCOM=$P(X,U)
COM2 S (COM,RES)=""
S X=$G(ARR("TODAY"))
S RES=$P(X,U),COM=$P(X,U,2)
CDIC S DIC="^VEN(7.16,",DIC(0)="L",DLAYGO=19707.16
S X=""""_CIEN_""""
D ^DIC I Y=-1 Q
S DA=+Y,GBL=$NA(^VEN(7.16))
S @GBL@(DA,0)=CIEN_U_CAT_"^^^^"_LAST_U_RES_U_VIEN_U_TYPE_U_KEY_U_U_DT_U ; TX RECORD
S @GBL@(DA,1)=LCOM_U_COM
S @GBL@("AC",KEY,DA)="",@GBL@("AD",DT,DA)="" ; INDEXES
S CNT=CNT+1
D ^XBFMK
Q
;
BENCH(LINE,CNT,CAT,KEY) ; EP - ADD AN ENTRY TO THE OUTPUT ARRAY. GET BENCHMARKS, LAST RESULTS, AND TODAYS RESULTS
N DIC,DA,CIEN,STOP,STG,ITEM,X,Y,%,GBL
S CIEN=$O(^VEN(7.11,"B",CAT,0)) I 'CIEN Q
S STOP=0
S DIC="^VEN(7.16,",DIC(0)="L",DLAYGO=19707.16
LINE F S LINE=$O(LINE(LINE)) Q:'LINE D I STOP Q ; PROCESS EACH LINE IN THE CATEGORY
IVARS . S STG=LINE(LINE)
. I $E(STG,1,3)'="__ " S STOP=1 Q
. S %=$E(STG,4,99),ITEM=$P(%,"|") I '$L(ITEM) Q
. I ITEM?1.3N1". ".E S ITEM=$P(ITEM," ",2,999)
DIC . S X=""""_CIEN_""""
. D ^DIC I Y=-1 Q
. S DA=+Y,GBL=$NA(^VEN(7.16))
. S @GBL@(DA,0)=CIEN_U_CAT_U_U_ITEM_"^^^^^2^"_KEY_U_U_DT_U ; TX RECORD
. S @GBL@("AC",KEY,DA)="",@GBL@("AD",DT,DA)="" ; INDEXES
. S CNT=CNT+1
. Q
D ^XBFMK
Q
;
TX ; EP - POPULATE THE TX FILE
N DIC,X,Y,Z,%
S DIC="^VEN(7.16,",DLAYGO=19707.16,DIC(0)="L"
D ^XBFMK
Q
;
TODAY(DFN,FLD,ARR) ; EP - GET TODAY'S RESULT
N VWCIEN,SS,PCE,COM,RES,%,X,Y,Z
S VWCIEN=$O(^AUPNVWC("AA",DFN,(9999999-DT),0)) I 'VWCIEN Q
S SS=$P(FLD,".") I 'SS Q
S PCE=+$P(FLD,".",2) I 'PCE Q
S COM=$P($G(^AUPNVWC(VWCIEN,SS)),U,PCE) I '$L(COM) Q
S RES=""
F X="NORMAL: ","BORDERLINE: ","ABNORMAL: " D I $L(RES) Q
. S Y=$L(X)
. I $E(COM,1,Y)'=X Q
. S RES=$P(COM,": ")
. S COM=$P(COM,": ",2,99)
. Q
I COM="OK",RES="" S RES="N"
S RES=$E(RES)
S ARR("TODAY")=RES_U_COM
Q
;
LAST(DFN,FLD,ARR) ; EP - GET THE LAST RESULT
N IDT,STOP,IDTMAX,%,SS,PCE,VWCIEN
S IDT=9999999-DT,VWCIEN=0,STOP=0
S %=DT-20000,IDTMAX=9999999-%
S SS=$P(FLD,".") I 'SS Q
S PCE=+$P(FLD,".",2) I 'PCE Q
F S IDT=$O(^AUPNVWC("AA",DFN,IDT)) Q:'IDT D I STOP Q
. I IDT>IDTMAX S STOP=1 Q
. S VWCIEN=0 F S VWCIEN=$O(^AUPNVWC("AA",DFN,IDT,VWCIEN)) Q:'VWCIEN D I STOP Q
.. S X=$P($G(^AUPNVWC(VWCIEN,SS)),U,PCE)
.. I '$L(X) Q
.. S ARR("LAST")=X_U_(9999999-IDT)_U_VWCIEN
.. S STOP=1
.. Q
. Q
Q
;
VENPCCKD ; IHS/OIT/GIS - GUI TRANSACTION MANAGER - DEVEL/AUTISM SCREENING COMMENTS ;
+1 ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
+2 ;
+3 ;
+4 ;
FLUSH(VIEN) ; EP - FLUSH RESULTS FROM TX TABLE TO V WELL CHILD AND CLEAN UP
+1 SET OUT=""
+2 IF '$DATA(^AUPNVSIT(+$GET(VIEN),0))
QUIT
+3 NEW TYPE,KEY,DIK,DIC,X,Y,Z,%,TXIEN,DFN
+4 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF '$DATA(^DPT(+DFN,0))
QUIT
+5 SET KEY=VIEN_"_2"
SET DIK="^VEN(7.16,"
SET DA=0
+6 ; CLEAN OUT DEVEL BENCHMARKS FROM TX FILE
FOR
SET DA=$ORDER(^VEN(7.16,"AC",KEY,DA))
IF 'DA
QUIT
DO ^DIK
+7 SET KEY=VIEN_"_9"
SET TXIEN=0
+8 ; PROCESS EVERY TX
FOR
SET TXIEN=$ORDER(^VEN(7.16,"AC",KEY,TXIEN))
IF 'TXIEN
QUIT
DO DF(TXIEN,DFN,VIEN)
+9 SET DIK="^VEN(7.16,"
SET DA=0
+10 ; CLEAN OUT DEVEL COMMENTS FROM TX FILE
FOR
SET DA=$ORDER(^VEN(7.16,"AC",KEY,DA))
IF 'DA
QUIT
DO ^DIK
+11 DO ^XBFMK
+12 QUIT
+13 ;
DF(TXIEN,DFN,VIEN) ; EP - CREATE THE V WELL CHILD ENTRIES
+1 NEW STG,X,Y,Z,%,DIC,DIE,DR,DA,GBL,COM,RES,CAT,FLD,SS,PCE,VWCIEN
+2 SET STG=$GET(^VEN(7.16,+$GET(TXIEN),0))
IF '$LENGTH(STG)
QUIT
+3 SET VWCIEN=$$VWC^VENPCCQC(DFN,VIEN)
IF '$DATA(^AUPNVWC(+VWCIEN,0))
QUIT
+4 SET GBL=$NAME(^AUPNVWC(VWCIEN))
+5 SET CAT=$PIECE(STG,U,2)
IF '$LENGTH(CAT)
QUIT
+6 SET FLD=$SELECT(CAT["FINE":3.01,CAT["GROSS":3.02,CAT["LANGU":3.03,CAT["SOCIAL":3.04,CAT["AUTISM":9.01,1:"")
IF 'FLD
QUIT
+7 SET SS=FLD\1
SET PCE=+$PIECE(FLD,".",2)
+8 ; CLEAN OUT PREVIOUS RESULTS FOR THIS CATEGORY
IF $DATA(@GBL@(SS))
SET $PIECE(@GBL@(SS),U,PCE)=""
+9 SET RES=$PIECE(STG,U,7)
SET COM=$PIECE($GET(^VEN(7.16,TXIEN,1)),U,2)
IF RES=""
IF COM=""
QUIT
+10 SET X=""
SET RES=$SELECT(RES="N":"NORMAL",RES="B":"BORDERLINE",RES="A":"ABNORMAL",1:"")
+11 IF $LENGTH(RES)
IF $LENGTH(COM)
SET X=RES_": "_COM
+12 IF X=""
IF $LENGTH(RES)
SET X=RES
+13 IF X=""
SET X=COM
+14 SET X=$EXTRACT(X,1,60)
+15 IF X="NORMAL: OK"
SET X="NORMAL"
+16 SET $PIECE(@GBL@(SS),U,PCE)=X
+17 SET OUT="OK"
+18 QUIT
+19 ;
POP(IN) ; EP - POPULATE THE TX TABLE WITH DEVEL ASSESSMENT INFO
+1 ; 2 SETS OF ITEMS NEED TO BE POPULATED: BENCHMARKS AND RESULTS. THESE WILL BE COMBINED INTO ONE GUI TABLE
+2 NEW LINE,ARR,VIEN,DFN,TYPE,KEY,DA,DIK,CAT,CNT,FLD,STOP,DIC,X,Y,Z,%
+3 DO VAR^VENPCCKT
IF '$DATA(LINE)
QUIT
DEV SET (LINE,CNT)=0
DEV1 IF LINE=""
GOTO DEV2
+1 SET STOP=0
+2 ; GET STARTING LINE FOR EXAM SUBCATEGORY
FOR
SET LINE=$ORDER(LINE(LINE))
IF 'LINE
QUIT
Begin DoDot:1
+3 SET CAT=""
+4 IF LINE(LINE)["FINE MOTOR (%"
SET STOP=1
SET CAT="FINE MOTOR"
SET FLD=3.01
QUIT
+5 IF LINE(LINE)["GROSS MOTOR (%"
SET STOP=1
SET CAT="GROSS MOTOR"
SET FLD=3.02
QUIT
+6 IF LINE(LINE)["LANGUAGE (%"
SET STOP=1
SET CAT="LANGUAGE"
SET FLD=3.03
QUIT
+7 IF LINE(LINE)["SOCIAL (%"
SET STOP=1
SET CAT="SOCIAL"
SET FLD=3.04
QUIT
+8 IF LINE(LINE)="AUTISM SCREEN"
SET STOP=1
SET CAT="AUTISM SCREEN"
SET FLD=9.01
QUIT
+9 QUIT
End DoDot:1
IF STOP
QUIT
DEV2 ; QUIT IF NO MORE DEVEL ITEMS EXIST
IF 'LINE!(CAT="")
Begin DoDot:1
+1 IF CNT
SET OUT="BMX ADO SS^VEN WCM TX^^AC~"_KEY_"~"_KEY_"~9999"
+2 DO ^XBFMK
+3 QUIT
End DoDot:1
QUIT
+4 SET CAT="WCDA DEVEL "_CAT
+5 ; ADD BENCHMARKS TO TX FILE
IF TYPE=2
DO BENCH(.LINE,.CNT,CAT,KEY)
GOTO DEV1
+6 KILL ARR
+7 ; BUILD LAST COMMENTS ARRAY
DO LAST(DFN,FLD,.ARR)
+8 ; GET TODAYS RESULTS
DO TODAY(DFN,FLD,.ARR)
+9 ; ADD DEVEL COMMENTS TO TX FILE
IF $DATA(ARR)
DO COM(.ARR,.CNT,CAT,FLD,KEY)
+10 ; PROCESS ANOTHER DEV CATEGORY
GOTO DEV1
+11 ;
COM(ARR,CNT,CAT,FLD,KEY) ; EP - UPDATE THE TX FILE WITH DEVEL COMMENTS
+1 NEW DIC,DA,CIEN,X,Y,%,GBLLAST,LCOM,COM,RES,LAST,VWCIEN,GBL
COM1 SET CIEN=$ORDER(^VEN(7.11,"B",CAT,0))
IF 'CIEN
QUIT
+1 SET (LAST,LCOM)=""
+2 SET X=$GET(ARR("LAST"))
IF '$LENGTH(X)
GOTO COM2
+3 SET Y=$PIECE(X,U,2)
+4 IF Y
SET LAST=$$FMTE^XLFDT(Y,"1D")
+5 IF $LENGTH(LAST)
SET LCOM=$PIECE(X,U)
COM2 SET (COM,RES)=""
+1 SET X=$GET(ARR("TODAY"))
+2 SET RES=$PIECE(X,U)
SET COM=$PIECE(X,U,2)
CDIC SET DIC="^VEN(7.16,"
SET DIC(0)="L"
SET DLAYGO=19707.16
+1 SET X=""""_CIEN_""""
+2 DO ^DIC
IF Y=-1
QUIT
+3 SET DA=+Y
SET GBL=$NAME(^VEN(7.16))
+4 ; TX RECORD
SET @GBL@(DA,0)=CIEN_U_CAT_"^^^^"_LAST_U_RES_U_VIEN_U_TYPE_U_KEY_U_U_DT_U
+5 SET @GBL@(DA,1)=LCOM_U_COM
+6 ; INDEXES
SET @GBL@("AC",KEY,DA)=""
SET @GBL@("AD",DT,DA)=""
+7 SET CNT=CNT+1
+8 DO ^XBFMK
+9 QUIT
+10 ;
BENCH(LINE,CNT,CAT,KEY) ; EP - ADD AN ENTRY TO THE OUTPUT ARRAY. GET BENCHMARKS, LAST RESULTS, AND TODAYS RESULTS
+1 NEW DIC,DA,CIEN,STOP,STG,ITEM,X,Y,%,GBL
+2 SET CIEN=$ORDER(^VEN(7.11,"B",CAT,0))
IF 'CIEN
QUIT
+3 SET STOP=0
+4 SET DIC="^VEN(7.16,"
SET DIC(0)="L"
SET DLAYGO=19707.16
LINE ; PROCESS EACH LINE IN THE CATEGORY
FOR
SET LINE=$ORDER(LINE(LINE))
IF 'LINE
QUIT
Begin DoDot:1
IVARS SET STG=LINE(LINE)
+1 IF $EXTRACT(STG,1,3)'="__ "
SET STOP=1
QUIT
+2 SET %=$EXTRACT(STG,4,99)
SET ITEM=$PIECE(%,"|")
IF '$LENGTH(ITEM)
QUIT
+3 IF ITEM?1.3N1". ".E
SET ITEM=$PIECE(ITEM," ",2,999)
DIC SET X=""""_CIEN_""""
+1 DO ^DIC
IF Y=-1
QUIT
+2 SET DA=+Y
SET GBL=$NAME(^VEN(7.16))
+3 ; TX RECORD
SET @GBL@(DA,0)=CIEN_U_CAT_U_U_ITEM_"^^^^^2^"_KEY_U_U_DT_U
+4 ; INDEXES
SET @GBL@("AC",KEY,DA)=""
SET @GBL@("AD",DT,DA)=""
+5 SET CNT=CNT+1
+6 QUIT
End DoDot:1
IF STOP
QUIT
+7 DO ^XBFMK
+8 QUIT
+9 ;
TX ; EP - POPULATE THE TX FILE
+1 NEW DIC,X,Y,Z,%
+2 SET DIC="^VEN(7.16,"
SET DLAYGO=19707.16
SET DIC(0)="L"
+3 DO ^XBFMK
+4 QUIT
+5 ;
TODAY(DFN,FLD,ARR) ; EP - GET TODAY'S RESULT
+1 NEW VWCIEN,SS,PCE,COM,RES,%,X,Y,Z
+2 SET VWCIEN=$ORDER(^AUPNVWC("AA",DFN,(9999999-DT),0))
IF 'VWCIEN
QUIT
+3 SET SS=$PIECE(FLD,".")
IF 'SS
QUIT
+4 SET PCE=+$PIECE(FLD,".",2)
IF 'PCE
QUIT
+5 SET COM=$PIECE($GET(^AUPNVWC(VWCIEN,SS)),U,PCE)
IF '$LENGTH(COM)
QUIT
+6 SET RES=""
+7 FOR X="NORMAL: ","BORDERLINE: ","ABNORMAL: "
Begin DoDot:1
+8 SET Y=$LENGTH(X)
+9 IF $EXTRACT(COM,1,Y)'=X
QUIT
+10 SET RES=$PIECE(COM,": ")
+11 SET COM=$PIECE(COM,": ",2,99)
+12 QUIT
End DoDot:1
IF $LENGTH(RES)
QUIT
+13 IF COM="OK"
IF RES=""
SET RES="N"
+14 SET RES=$EXTRACT(RES)
+15 SET ARR("TODAY")=RES_U_COM
+16 QUIT
+17 ;
LAST(DFN,FLD,ARR) ; EP - GET THE LAST RESULT
+1 NEW IDT,STOP,IDTMAX,%,SS,PCE,VWCIEN
+2 SET IDT=9999999-DT
SET VWCIEN=0
SET STOP=0
+3 SET %=DT-20000
SET IDTMAX=9999999-%
+4 SET SS=$PIECE(FLD,".")
IF 'SS
QUIT
+5 SET PCE=+$PIECE(FLD,".",2)
IF 'PCE
QUIT
+6 FOR
SET IDT=$ORDER(^AUPNVWC("AA",DFN,IDT))
IF 'IDT
QUIT
Begin DoDot:1
+7 IF IDT>IDTMAX
SET STOP=1
QUIT
+8 SET VWCIEN=0
FOR
SET VWCIEN=$ORDER(^AUPNVWC("AA",DFN,IDT,VWCIEN))
IF 'VWCIEN
QUIT
Begin DoDot:2
+9 SET X=$PIECE($GET(^AUPNVWC(VWCIEN,SS)),U,PCE)
+10 IF '$LENGTH(X)
QUIT
+11 SET ARR("LAST")=X_U_(9999999-IDT)_U_VWCIEN
+12 SET STOP=1
+13 QUIT
End DoDot:2
IF STOP
QUIT
+14 QUIT
End DoDot:1
IF STOP
QUIT
+15 QUIT
+16 ;
