VENPCCQ1.m

VENPCCQ1 ; IHS/OIT/GIS - KNOWLEDGEBASE UTILITIES FOR ASQ GUI DATA CAPTURE ; 12 Jul 2011  7:49 AM

 ;;2.6;PCC+;**1,4**;APR 03, 2012;Build 24

 ;

 D TX(.OUT,"27254|2677336") W !,OUT Q

 D FLUSH(.OUT,"~1~4~1004~2199") W !,OUT Q

 ;

VISIT(OUT,IN) ; EP - RPC: VEN ASQ GET VISITS

 ; GIVEN DFN, RETURN PATIENT IDENTIFIERS AND CANDIDATE VISIT IDENTIFIERS

 I '$D(^DPT(+$G(IN),0)) Q

 N NAME,DOB,MOM,X,Y,%,AUPNPAT,AUPNSEX,AUPNDOB,AUPNDAYS,AUPNDOD,B,GA,DFN,TS,VSTG,CSIEN,CS

 S OUT="",B="|",DFN=+IN

 S DIC="^AUPNPAT(",X="`"_DFN,DIC(0)="M"

 D PLK^VENPCCQ I OUT="" Q

 S IDT=9999999-(DT\1),BDT=9999999-$$FMADD^XLFDT(DT,-365)

 S IDT=IDT-.0000001,VSTG=""

 F  S IDT=$O(^AUPNVSIT("AA",DFN,IDT)) Q:'IDT  Q:IDT>BDT  S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN)) Q:'VIEN  D

 . S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q

 . S TS=$$FMTE^XLFDT(+X) I '$L(TS) Q

 . S CSIEN=$P(X,U,8) I 'CSIEN Q

 . S CS=$P($G(^DIC(40.7,CSIEN,0)),U) I '$L(CS) Q

 . S VSTG=VSTG_"\"_VIEN_B_TS_B_CS

 . Q

 I $L($G(VSTG)) S OUT=OUT_VSTG

 Q

 ;

TX(OUT,IN) ; EP - RPC: VEN ASQ START TX

 ; GIVEN DFN|VIEN POPULATE THE TX FILE AND RETURN THE TABLE GEN STRING

HX ; EP FROM HXASQ

 S OUT=0

 N B,DFN,VIEN,M,MOS1,MOS2,ASQAGE,CAGE,ASQ1,ASQ2,DATE1,DATE2,DOB,ADOB,GA,F1,FC1,F2,FC2,G1,GC1,G2,GC2,C1,CC1,C2,CC2

 N S1,SC1,S2,SC2,P1,PC1,P2,PC2,DIC,DIE,DA,DR,LSTG,PCE,V,C,TODAY,DIK,DIC,DIE,DLAYGO,DA,DR,QIEN,FMDT,TABLE,EDOB,FLD

 N AUPNPAT,AUPNSEX,AUPNDOB,AUPNDAYS,AUPNDOD,MULT,TVIEN,LOCKED,START,FIN,VDT,X,Y,Z,%,OPEN,EDIT,LDT,MVIEN,VIEN,ASQM,OLD

 S B="|"

 S DFN=+$G(IN) I '$D(^DPT(DFN,0)) Q

 S TODAY=$P(IN,B,4)

 S VDT=+$G(^AUPNVSIT(+$G(TVIEN),0))\1

 I 'VDT S VDT=$G(DT)

 S DATE=VDT

CLEANUP S DIK="^VEN(7.15,",DA=0

 F  S DA=$O(^VEN(7.15,"B",DFN,DA)) Q:'DA  D ^DIK ; DELETE ALL ASQ TX FILE ENTRIES FOR THIS PATIENT

 S TVIEN=+$P(IN,B,2) ; TODAYS VISIT

POP N LSTG0,LSTG1

 D MLSTG(DFN,TVIEN,.LSTG0,.LSTG1) ; GET ALL THE ASQ RESULTS - INCLUDING RESULTS RESULTS FOR CURRENT VISIT

 ; I '$L(LSTG0),'$G(TVIEN) Q  ; NO PAST RESULTS AND NO CURRENT VISIT SPECIFIED, SO QUIT (OUT=0)

 I '$L(LSTG0) D T1(DFN,DATE,TVIEN,.TODAY,.START,.FIN) S EDIT=1002 G OUT ; NO ASQ RESULTS FOUND - NEW ROW ONLY

 ; AT THIS POINT WE KNOW THERE IS OLD DATA

 D MPOP(DFN,LSTG0,LSTG1,.START,.FIN) ; POPULATE THE TX TABLE WITH ASQ RESULTS: START/FIN ARE DEFINED

 ; I '$G(TVIEN) S EDIT=1001 G OUT ; CURRENT VISIT NOT SPECIFIED - ONLY ALLOW OLD ROWS

 ; AT THIS POINT WE KNOW THERE IS A CURRENT VISIT

 I $$FMDIFF^XLFDT(DT,VDT)>3 S EDIT=1001 G OUT ; CURRENT VISIT >72 HRS OLD - ONLY ALLOW OLD ROWS

 S ASQM=$O(^AUTTMSR("C",66,0)),Z=999999999,OLD=0

 I $G(TVIEN) F  S Z=$O(^AUPNVMSR("AD",TVIEN,Z),-1) Q:'Z  I +$G(^AUPNVMSR(Z,0))=ASQM S OLD=1 Q  ; CHECK TO SEE IF THERE IS ALREADY ASQ DATA FOR THIS VISIT

 I 'OLD D T1(DFN,DATE,TVIEN,.TODAY,.START,.FIN) S EDIT=1003 G OUT ; NO CURRENT ROW: NEW ROW ADDED + OLD DATA

 ; AT THIS POINT WE KNOW THERE IS ASQ DATA ASSOCIATED WITH THE CURRENT VISIT

 S X=$O(^AUPNVMSR("AA",DFN,+ASQM,0)) ; GET CURRENT ASQ 

 I ((9999999-X)\1)<VDT S EDIT=1001 G OUT ; CURRENT VISIT IS NOT THE MOST RECENT ASQ VISIT: CURRENT ROW IS LOCKED  - ALLOW OLD DATA ONLY

 S EDIT=1004 ; CURRENT ROW IS EDITABLE (CURRENT ROW IS PART OF OLD DATA SET)

OUT S OUT="BMX ADO SS^VEN ASQ TX^^~"_START_"~"_FIN_"~"_EDIT ; GET TABLE GEN STRING FOR THIS ASQ MEASUREMENT

 D ^XBFMK

 ; THE VARIABLE 'TABLE' TELLS THE OBJECT WHAT CAN BE DONE: 1001=OLD VALUES ONLY,1002=NEW VALUE ONLY,1003=OLD AND 1 NEW ROW,1004=OLD WITH 1 EDITABLE ROW

 Q

 ;

T1(DFN,DATE,TVIEN,TODAY,START,FIN) ; BUILD NEW ROW

 S TODAY="",START=$G(START),FIN=$G(FIN)

 I $G(DATE),$G(DFN)

 E  Q

 N X,Y,Z,%,DOB,EDOB,MOS2,ADOB,GA,ASQ2,FC2,GC2,CC2,SC2,DATE2,DIC,DIE,DA,DR,M,QIEN

 S M=$$ASQAGE^VENPCCQ(DFN,DATE) I 'M Q  ; ADJUSTED (ASQ) AGE IN MOS

 S QIEN=+$$ASQIEN^VENPCCQ(M) I 'QIEN Q  ; QUESTIONNAIRE IEN

 S DOB=$P($G(^DPT(DFN,0)),U,3)

 S EDOB=$$FMTE^XLFDT(DOB,"2D") ; PRINTED DOB

 S MOS2=$$DOBAGE^VENPCCQ(DFN,DATE) ; CHRONOLICAL AGE IN MONTHS

 S ADOB=$$ASQDOB^VENPCCQ(DFN) ; ADJUSTED (ASQ) DOB

 I ADOB S ADOB=$$FMTE^XLFDT(ADOB,"2D")

 S GA=$P($G(^AUPNBMSR(DFN,0)),U,6) ; GESTATIONAL AGE FROM BIRTH MEASUREMENT FILE

 S %=$G(^VEN(7.14,QIEN,0)) I '$L(%) Q

 S ASQ2=$P(%,U,1) ; QUESTIONNAIRE (MONTH)

 S FC2="("_$P(%,U,4)_")" ; FINE MOTOR CUTOFF

 S GC2="("_$P(%,U,3)_")" ; GROSS MOTOR CUTOFF

 S CC2="("_$P(%,U,2)_")" ; COMMUNICATION CUTOFF

 S SC2="("_$P(%,U,6)_")" ; PERSONAL-SOCIAL CUTOFF

 S PC2="("_$P(%,U,5)_")" ; PROBLEM SOLVING CUTOFF

 S DATE2=$$FMTE^XLFDT(DATE,"2D")

 S DIC="^VEN(7.15,",DIC(0)="L",DLAYGO=19707.15,X=""""_DFN_""""

 D ^DIC I Y=-1 S IEN="" D ^XBFMK Q

 I '$G(START) S START=+Y ; IEN IN THE ASQ TX FILE FOR TODAY'S NEW ENTRY

 S (TODAY,FIN)=+Y

 S ^VEN(7.15,+Y,0)=DFN_U_DATE2_U_ASQ2_U_MOS2_U_EDOB_U_ADOB_U_GA_U_TVIEN

 S ^VEN(7.15,+Y,1)=U_FC2_U_"*"_U_GC2_U_"*"_U_CC2_U_"*"_U_SC2_U_"*"_U_PC2_U_"*"

 D ^XBFMK

 Q

 ; 

LSTG(DFN) ; EP - GET LAST ASQ VALUES

 ; DEAD CODE

 N LSTG,IDT,STOP,WCIEN,STG,PCE,V,C,X,Y,Z,%

 N F1,FC1,G1,GC1,C1,CC1,S1,SC1,P1,PS1,ASQIEN

 S LSTG=""

 S IDT=0,STOP=0

 F  S IDT=$O(^AUPNVWC("AA",DFN,IDT)) Q:'IDT  D  I STOP Q

 . S WCIEN=0

 . F  S WCIEN=$O(^AUPNVWC("AA",DFN,IDT,WCIEN)) Q:'WCIEN  D  I STOP Q

 .. S STG=$G(^AUPNVWC(WCIEN,2)) I '$P(STG,U,7) Q

 .. I STG?1."^" Q

 .. S VIEN=$P($G(^AUPNVWC(WCIEN,0)),U,3) I 'VIEN Q

 .. S FMDT=+^AUPNVSIT(VIEN,0)\1

 .. S DATE1=$$FMTE^XLFDT(FMDT,2) ; DATE OF LAST ASQ

 .. S ASQIEN=$P(STG,U,7) I 'ASQIEN Q  ; MUST HAVE A VALID ASQ IEN

 .. S ASQ1=+$G(^VEN(7.14,ASQIEN,0)) I 'ASQ1 Q  ; MUST HAVE A VALID QUESTIONNAIRE MONTH

 .. S MOS1=$$LASTAGE(DFN,FMDT)  ; GET AGE IN MOS AT LAST VISIT

 .. S STOP=1

 .. F PCE=1:1:5 D

 ... S %=$E("FGCSP",PCE)

 ... S V=%_1,C=%_"C1"

 ... S X=$P(STG,U,PCE),Y=+X,Z=+$P(X,"(",2)

 ... I $P(X," ")'="" S @V=Y

 ... I Z S @C=Z

 ... Q

 .. Q

 . Q

 S LSTG=$G(F1)_U_$G(FC1)_U_$G(G1)_U_$G(GC1)_U_$G(C1)_U_$G(CC1)_U_$G(S1)_U_$G(SC1)_U_$G(P1)_U_$G(PC1)

 Q LSTG

 ;

LASTAGE(DFN,DT) ; EP - GET LAST AGE IN MONTHS

 Q $$DOBAGE^VENPCCQ(DFN)

 ;

FLUSH(OUT,IN) ; EP - RPC: VEN ASQ FLUSH

 ; FLUSH ASQ DATA OUT OF TX FILE INTO V FILES

 S OUT=""

 N IEN,DIC,DIE,DA,DR,X,Y,Z,%,VIEN,VDT,XDT,TIEN,DFN,ASQ,F,FC,G,GC,C,CC,S,SC,P,PC,ASQIEN,NOW,PRVIEN

 N DATE,FMDT,%DT,PCE,STG,V1,V2,GBL,VSTG,VAL,ENT,PRVIEN,NOW,EDT,RDT,KALL,ROW

 S IEN(1)=+$P($G(IN),"~",2),IEN(2)=+$P($G(IN),"~",3),IEN(3)=$P($G(IN),"~",4)

 I IEN(3),IEN(2),IEN(1)

 E  Q

 S ROW=$S(IEN(3)=1003:IEN(2),1:IEN(1)) I 'ROW Q

 S TIEN=ROW,PRVIEN=+$P($G(IN),"~",5) ; ,NOW=$E($$NOW^XLFDT,1,12)

 S DFN=+$G(^VEN(7.15,ROW,0)) I 'DFN Q

 S VIEN=$P(^VEN(7.15,ROW,0),U,8) I 'VIEN Q

 S VDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'VDT Q

FL1 S X=$G(^VEN(7.15,TIEN,0))

 S DFN=+X,ASQ=$P(X,U,3),DATE=$P(X,U,2),EDT="",RDT=$G(DT)

FL2 S ASQIEN=$O(^VEN(7.14,"B",+$G(ASQ),0))

 I 'ASQIEN D ASQCLEAN(VIEN) S OUT="OK" Q  ; ASQ FORM NOT DEFINED, SO DELETE ALL OF THE VISIT'S ASQ RESULTS AND QUIT

 ; S X=DATE D ^%DT S FMDT=Y

 S STG=$G(^VEN(7.15,TIEN,1)) I '$L(STG) Q

 F PCE=1:1:5 D

 . S %=$E("FGCSP",PCE)

 . S V1=%,V2=%_"C"

 . I PCE=1 S X=$P(STG,U,11),Y=$P(STG,U,2)

 . E  S Z=(PCE*2)-1,X=$P(STG,U,Z),Y=$P(STG,U,Z+1)

 . S Y=$TR(Y,"(",""),Y=$TR(Y,")","")

 . S @V1=X,@V2=Y

 . Q

 S VSTG=F_" ("_FC_")^"_G_" ("_GC_")^"_C_" ("_CC_")^"_S_" ("_SC_")^"_P_" ("_PC_")^^"_ASQ

 I $G(NOWC) G MEAS

WC ; V WELL CHILD ENTRY

 S DA=$$VWC(DFN,VIEN) I 'DA G MEAS ; GET V WELL CHILD RECORD NUMBER

 S GBL=$NA(^AUPNVWC(DA,2))

 S @GBL=VSTG

MEAS ; V MEASUREMENTS ENTRY

 S KALL=0,DA=""

 F PCE=7,1:1:5 S VAL=$P(VSTG,U,PCE) D

 . I PCE=7,+VAL=0 S KALL=1  ; KILL ALL ASQ MEASUREMENTS FOR THIS VISIT

 . E  I PCE=7,$O(^VEN(7.14,"B",+$G(VAL),0))="" S KALL=1 ; MUST BE A LEGIT ASQ MONTH

 . I +VAL=0!(KALL) S VAL="@"  ; DELETE THE V MEASUREMENT ENTRY

 . D ASQVMSR(PCE,VAL,VIEN,VDT,PRVIEN,EDT,RDT) ; MAKE INDIVIDUAL V MEAS ENTRIES

 . Q

DEL S DIK="^VEN(7.15,",DA=""

 F  S DA=$O(^VEN(7.15,"B",DFN,DA)) Q:'DA  I $D(^VEN(7.15,DA)) D ^DIK ; CLEAN UP THE TX FILE

 S OUT="OK"

 D ^XBFMK

 Q

 ;

ASQCLEAN(VIEN) ; IF THERE IS NO ASQ MONTH VALUE, CLEAN OUT ALL ASQ RESULTS FOR THIS VISIT.

 I VIEN

 E  Q

 N DIC,DIE,DA,DR,DIK,X,Y,Z,%,MVIEN,WREF

 S DA=0,WREF="^AUPNVWC",DIK="^AUPNVMSR("

 F  S DA=$O(^AUPNVWC("AD",VIEN,DA)) Q:'DA  K @WREF@(DA,2) ; CLEAN OUT THE ASQ NODE (2) IN THE V WELL CHILD FILE

 F  S DA=$O(^AUPNVMSR("AD",VIEN,DA)) Q:'DA  D

 . S X=+$G(^AUPNVMSR(DA,0)) I 'X Q

 . S Y=$P($G(^AUTTMSR(X,0)),U) I $E(Y,1,3)'="ASQ" Q

 . D ^DIK

 . Q

 D ^XBFMK

 Q

 ; 

EHRFLUSH(OUT,IN) ; EP  - VEN ASQ EHR FLUSH

 ; GIVEN THE PATIENT IEN, FLUSH TODAY'S ASQ RESULTS TO THE V MEASUREMENT FILE

 S OUT=""

 I $G(IN),$D(^AUPNVSIT(+IN,0))

 E  Q

 N DFN,VSTG,TIEN,X,Y,Z,%,VIEN,NOWC,ASQ,DATE,ASQIEN,STG,PCE,V1,V2,VSTG,VAL,DIK,DIC,DIE,DA,DR,VDT

 S VIEN=+IN

 S VDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'VDT Q

 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q

 S TIEN=99999999

 F  S TIEN=$O(^VEN(7.15,"B",DFN,TIEN),-1) Q:'TIEN  I $P($G(^VEN(7.15,TIEN,0)),U,8)=VIEN Q  ; FIND THE ROW ASSOCIATED WITH TODAY'S VISIT

 I TIEN S NOWC=1 D FL1 S DA=TIEN,DIK="^VEN(7.15," D ^DIK,^XBFMK

 Q

 ; 

VWC(DFN,VIEN) ; EP - RETURN THE V WELL CHILD IEN - CREATE A NEW ONE IF NECESSARY

 I '$G(DFN)!('$G(VIEN)) Q ""

 N DIC,DIE,DR,DA,X,Y,VDT,GBL

 S VDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'VDT Q ""

 S DA=$O(^AUPNVWC("AD",VIEN,999999999),-1) I DA Q DA ; A RECORD HAS ALREADY BEEN CREATED - GET LATEST V WC RECORD

 S DIC="^AUPNVWC(",DIC(0)="L",DLAYGO=9000010.46,X=""""_0_""""

 D ^DIC

 I Y=-1 Q ""

 S GBL="^AUPNVWC"

 S DA=+Y,DIE=DIC,DR=".02////^S X=DFN;.03////^S X=VIEN"

 L +^AUPNVWC(DA):1 I  D ^DIE L -^AUPNVWC(DA)

 S @GBL@("AC",DFN,DA)="",@GBL@("AD",VIEN,DA)="",@GBL@("AA",DFN,9999999-VDT,DA)=""

 Q DA

 ;

ASQVMSR(PCE,VAL,VIEN,VDT,PRVIEN,EDT,RDT) ; EP - FILE ASQ SCORES IN V MEASUREMNTS

 N DIE,DIC,DA,DR,X,Y

 S DIE="^AUPNVMSR("

 S X=$P("ASQF^ASQG^ASQL^ASQS^ASQP^^ASQM",U,PCE) I X="" Q

 S DA=$$VMSR(VIEN,X,VAL) I 'DA Q  ; FIND EXISTING V MEASUREMENT, OR MAKE A NEW ONE, OR KILL OLD ONE IF VAL="@"

 I VAL="@" Q

 S DR=".04////^S X=VAL;.08////^S X=PRVIEN;1204////^S X=PRVIEN"

 I $P($G(^AUPNVMSR(DA,0)),U,2)="" S DR=".02////^S X=DFN;.03////^S X=VIEN;"_DR

 I '$G(EDT) S EDT=$G(VDT)\1

 I $G(EDT) S DR=DR_";1201////^S X=EDT"

 I $G(RDT) S DR=DR_";.07////^S X=RDT"

SETMSR L +^AUPNVMSR(DA):1 I  D ^DIE L -^AUPNVMSR(DA)

 Q

 ; 

VMSR(VIEN,TYPE,VAL) ; EP - FIND OR CREATE A V MEASUREMENT ENTRY

 N MIEN,VMIEN,DIC,X,Y,DIK,DA

 S MIEN=$O(^AUTTMSR("B",TYPE,0)) I 'MIEN Q "" ; GET THE MEASUREMENT IEN

 S VMIEN=0

 F  S VMIEN=$O(^AUPNVMSR("AD",VIEN,VMIEN)) Q:'VMIEN  I +$G(^AUPNVMSR(VMIEN,0))=MIEN Q

 I VMIEN,VAL="@" S DIK="^AUPNVMSR(",DA=VMIEN D ^DIK K DIK,DA ; DELETE EXISTING ENTRY BECAUSE THERE IS NO VALUE

 I VAL="@" Q ""  ; NO NEW V MED ENTRY BECAUSE VAL IS NULL

 I VMIEN Q VMIEN ; A V MEAS ENTRY ALREADY EXISTS FOR THIS ASQ CATEGORY AND VISIT

 ; AT THIS POINT THERE IS NO EXISTING ENTRY BUT THERE IS A VALID VALUE, SO MAKE A NEW V MEAS ENTRY STUB

 S DIC="^AUPNVMSR(",DIC(0)="L",DLAYGO=9000010.01

 S X=""""_TYPE_""""

 D ^DIC I Y=-1 Q "" ; MAKE A NEW V MEAS ENTRY

 Q +Y

 ; 

MLSTG(DFN,TVIEN,LSTGX,LSTG1) ; EP - GET LAST ASQ VALUES

 S LSTGX="",LSTG1=""

 N IDT,STOP,STG,PCE,V,C,X,Y,Z,%,ASQIEN,VIEN

 N ASQA,ASQF,ASQG,ASQL,ASQM,ASQP,ASQS,I,STG,TYPE,RIEN,VMIEN,MSR,MTYP

 N F,FC,G,GC,L,LC,S,SC,P,PC,VAL,MIEN,ASQ1,MOS1,DATE1,FMDT,REDT,CUT,CP,FIEN,VARR,MOS

 S STG="AFGLMPS"

 F I=1:1:$L(STG) S X=$E(STG,I) S Y=$O(^AUTTMSR("B",("ASQ"_X),0)) Q:'Y  S @("ASQ"_X)=Y

 I '$G(ASQM) Q  ; THIS IS THE ONLY REQUIRED MEASUREMENT

 S IDT=0,STOP=0

 F  S IDT=$O(^AUPNVMSR("AA",DFN,ASQM,IDT)) Q:'IDT  D  ; BUILD VISIT ARRAY BASED ON THE EXISTANCE OF ASQM

 . S MIEN=9999999999

 . F  S MIEN=$O(^AUPNVMSR("AA",DFN,ASQM,IDT,MIEN),-1) Q:'MIEN  D

 .. S VIEN=$P($G(^AUPNVMSR(MIEN,0)),U,3) I 'VIEN Q

 .. S MOS=$P(^AUPNVMSR(MIEN,0),U,4) I 'MOS Q

 .. S VARR(VIEN)=MOS

 .. Q

 . Q

 F RIEN=ASQM,ASQA,ASQF,ASQG,ASQL,ASQP,ASQS D  ; NOW GET ALL THE ASQ MEASUREMENTS FOR EACH VISIT

 . S IDT=0

 . S MTYP=$P($G(^AUTTMSR(RIEN,0)),U) I MTYP="" Q

 . F  S IDT=$O(^AUPNVMSR("AA",DFN,RIEN,IDT)) Q:'IDT  D

 .. S MIEN=9999999999

 .. F  S MIEN=$O(^AUPNVMSR("AA",DFN,RIEN,IDT,MIEN),-1) Q:'MIEN  D

 ... S VIEN=$P($G(^AUPNVMSR(MIEN,0)),U,3) I '$D(VARR(+VIEN)) Q

 ... S VARR(VIEN,MIEN)=MTYP

 ... Q

 .. Q

 . Q

SV S VIEN=9999999999 F  S VIEN=$O(VARR(VIEN),-1) Q:'VIEN  D

 . S FMDT=+^AUPNVSIT(VIEN,0)\1 I 'FMDT Q

 . S (F,G,L,S,P)="" ; FOR EACH VISIT PROCESSED, REFRESH ALL VALUES

 . S MOS=VARR(VIEN),FIEN=$O(^VEN(7.14,"B",MOS,0)) I 'FIEN Q  ; ASQ FROM (MOS) AND ASQ FORM IEN

 . S MIEN=0 F  S MIEN=$O(VARR(VIEN,MIEN)) Q:'MIEN  D

 .. I $P($G(^AUPNVMSR(MIEN,2)),U) Q  ; BYPASS ALL RESULTS ENTERED IN ERROR

 .. S %=$P($G(^AUPNVMSR(MIEN,12)),U) I % S FMDT=%\1 ; EVENT DATE REPLACES VISIT DATE (IF AVAILABLE)

 .. S DATE1=$$FMTE^XLFDT(FMDT,2) ; DATE OF LAST ASQ - EXTERNAL FORMAT

 .. S MOS1=$$LASTAGE(DFN,FMDT)  ; GET AGE IN MOS AT LAST VISIT

 .. S REDT=$P($G(^AUPNVMSR(MIEN,0)),U,7) ; DATE RESULTS ENTERED

 .. S MTYP=VARR(VIEN,MIEN)

 .. S MSR=$E(MTYP,4) I MSR="" Q

 .. D CUTOFF(MSR,FIEN)

 .. S VAL=$P($G(^AUPNVMSR(MIEN,0)),U,4)

 .. S @MSR=$P(VAL," ")

 .. Q

 . I $L(LSTGX) S LSTGX=LSTGX_"|"

 . S LSTGX=LSTGX_DFN_U_$G(DATE1)_U_MOS_U_$G(MOS1)_U_$G(EDOB)_U_$G(ADOB)_U_$G(GA)_U_VIEN

 . I $L(LSTG1) S LSTG1=LSTG1_"|"

 . I VIEN=TVIEN F MSR="F","G","L","P","S" I @MSR="" D CUTOFF(MSR,FIEN) ; FOR CURRENT VISIT, MAKE SURE THAT THE CUTOFF SCORE IS ALWAYS DISPLAYED

 . S LSTG1=LSTG1_U_$G(FC)_U_$G(G)_U_$G(GC)_U_$G(L)_U_$G(LC)_U_$G(S)_U_$G(SC)_U_$G(P)_U_$G(PC)_U_$G(F)

 . Q

 Q

 ; 

CUTOFF(MSR,FIEN) ; POPULATE THE CUTOFF SCORE ARRAY

 N CP,%

 S CP=$S(MSR="F":4,MSR="G":3,MSR="L":2,MSR="P":5,MSR="S":6,1:"")

 I CP="" Q

 S %=$P($G(^VEN(7.14,FIEN,0)),U,CP) I '% Q  ; FORM MOS

 S @(MSR_"C")="("_%_")" ; THE CUTOFF VALUE IS A TEXT STRING - A NUMBER INSIDE PARENTHESES

 Q

 ; 

MPOP(DFN,LSTG0,LSTG1,START,FIN) ; GIVEN A PATIENT IEN AND ASQ RESULTS STRING, POPULATE THE ASQ TRANSACTION TABLE RETURNING THE STARTING IENS AKA LAST

 S START="",FIN=""

 I $G(DFN),$G(LSTG0)'="",$G(LSTG1)'=""

 E  Q

 N X,Y,Z,DIC,DLAYGO,STG,PCE,STG1,STG0,MAX

 S DIC="^VEN(7.15,",DIC(0)="LO",DLAYGO=19707.15,MAX=$L(LSTG1,"|")

 F PCE=1:1:MAX D

 . S STG0=$P(LSTG0,"|",PCE) I STG0="" Q

 . S STG1=$P(LSTG1,"|",PCE) I STG1="" Q

 . S X=""""_DFN_""""

 . D ^DIC I Y=-1 Q

 . I 'START S START=+Y

 . S ^VEN(7.15,+Y,0)=STG0

 . S ^VEN(7.15,+Y,1)=STG1

 . S FIN=+Y

 . Q

 Q

 ; 

VENPCCQ1  ; IHS/OIT/GIS - KNOWLEDGEBASE UTILITIES FOR ASQ GUI DATA CAPTURE ; 12 Jul 2011  7:49 AM

 +1       ;;2.6;PCC+;**1,4**;APR 03, 2012;Build 24

 +2       ;

 +3        DO TX(.OUT,"27254|2677336")

           WRITE !,OUT

           QUIT 

 +4        DO FLUSH(.OUT,"~1~4~1004~2199")

           WRITE !,OUT

           QUIT 

 +5       ;

VISIT(OUT,IN) ; EP - RPC: VEN ASQ GET VISITS

 +1       ; GIVEN DFN, RETURN PATIENT IDENTIFIERS AND CANDIDATE VISIT IDENTIFIERS

 +2        IF '$DATA(^DPT(+$GET(IN),0))

               QUIT 

 +3        NEW NAME,DOB,MOM,X,Y,%,AUPNPAT,AUPNSEX,AUPNDOB,AUPNDAYS,AUPNDOD,B,GA,DFN,TS,VSTG,CSIEN,CS

 +4        SET OUT=""

           SET B="|"

           SET DFN=+IN

 +5        SET DIC="^AUPNPAT("

           SET X="`"_DFN

           SET DIC(0)="M"

 +6        DO PLK^VENPCCQ

           IF OUT=""

               QUIT 

 +7        SET IDT=9999999-(DT\1)

           SET BDT=9999999-$$FMADD^XLFDT(DT,-365)

 +8        SET IDT=IDT-.0000001

           SET VSTG=""

 +9        FOR 

               SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))

               IF 'IDT

                   QUIT 

               IF IDT>BDT

                   QUIT 

               SET VIEN=0

               FOR 

                   SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,IDT,VIEN))

                   IF 'VIEN

                       QUIT 

                   Begin DoDot:1

 +10                   SET X=$GET(^AUPNVSIT(VIEN,0))

                       IF '$LENGTH(X)

                           QUIT 

 +11                   SET TS=$$FMTE^XLFDT(+X)

                       IF '$LENGTH(TS)

                           QUIT 

 +12                   SET CSIEN=$PIECE(X,U,8)

                       IF 'CSIEN

                           QUIT 

 +13                   SET CS=$PIECE($GET(^DIC(40.7,CSIEN,0)),U)

                       IF '$LENGTH(CS)

                           QUIT 

 +14                   SET VSTG=VSTG_"\"_VIEN_B_TS_B_CS

 +15                   QUIT 

                   End DoDot:1

 +16       IF $LENGTH($GET(VSTG))

               SET OUT=OUT_VSTG

 +17       QUIT 

 +18      ;

TX(OUT,IN) ; EP - RPC: VEN ASQ START TX

 +1       ; GIVEN DFN|VIEN POPULATE THE TX FILE AND RETURN THE TABLE GEN STRING

HX        ; EP FROM HXASQ

 +1        SET OUT=0

 +2        NEW B,DFN,VIEN,M,MOS1,MOS2,ASQAGE,CAGE,ASQ1,ASQ2,DATE1,DATE2,DOB,ADOB,GA,F1,FC1,F2,FC2,G1,GC1,G2,GC2,C1,CC1,C2,CC2

 +3        NEW S1,SC1,S2,SC2,P1,PC1,P2,PC2,DIC,DIE,DA,DR,LSTG,PCE,V,C,TODAY,DIK,DIC,DIE,DLAYGO,DA,DR,QIEN,FMDT,TABLE,EDOB,FLD

 +4        NEW AUPNPAT,AUPNSEX,AUPNDOB,AUPNDAYS,AUPNDOD,MULT,TVIEN,LOCKED,START,FIN,VDT,X,Y,Z,%,OPEN,EDIT,LDT,MVIEN,VIEN,ASQM,OLD

 +5        SET B="|"

 +6        SET DFN=+$GET(IN)

           IF '$DATA(^DPT(DFN,0))

               QUIT 

 +7        SET TODAY=$PIECE(IN,B,4)

 +8        SET VDT=+$GET(^AUPNVSIT(+$GET(TVIEN),0))\1

 +9        IF 'VDT

               SET VDT=$GET(DT)

 +10       SET DATE=VDT

CLEANUP    SET DIK="^VEN(7.15,"

           SET DA=0

 +1       ; DELETE ALL ASQ TX FILE ENTRIES FOR THIS PATIENT

           FOR 

               SET DA=$ORDER(^VEN(7.15,"B",DFN,DA))

               IF 'DA

                   QUIT 

               DO ^DIK

 +2       ; TODAYS VISIT

           SET TVIEN=+$PIECE(IN,B,2)

POP        NEW LSTG0,LSTG1

 +1       ; GET ALL THE ASQ RESULTS - INCLUDING RESULTS RESULTS FOR CURRENT VISIT

           DO MLSTG(DFN,TVIEN,.LSTG0,.LSTG1)

 +2       ; I '$L(LSTG0),'$G(TVIEN) Q  ; NO PAST RESULTS AND NO CURRENT VISIT SPECIFIED, SO QUIT (OUT=0)

 +3       ; NO ASQ RESULTS FOUND - NEW ROW ONLY

           IF '$LENGTH(LSTG0)

               DO T1(DFN,DATE,TVIEN,.TODAY,.START,.FIN)

               SET EDIT=1002

               GOTO OUT

 +4       ; AT THIS POINT WE KNOW THERE IS OLD DATA

 +5       ; POPULATE THE TX TABLE WITH ASQ RESULTS: START/FIN ARE DEFINED

           DO MPOP(DFN,LSTG0,LSTG1,.START,.FIN)

 +6       ; I '$G(TVIEN) S EDIT=1001 G OUT ; CURRENT VISIT NOT SPECIFIED - ONLY ALLOW OLD ROWS

 +7       ; AT THIS POINT WE KNOW THERE IS A CURRENT VISIT

 +8       ; CURRENT VISIT >72 HRS OLD - ONLY ALLOW OLD ROWS

           IF $$FMDIFF^XLFDT(DT,VDT)>3

               SET EDIT=1001

               GOTO OUT

 +9        SET ASQM=$ORDER(^AUTTMSR("C",66,0))

           SET Z=999999999

           SET OLD=0

 +10      ; CHECK TO SEE IF THERE IS ALREADY ASQ DATA FOR THIS VISIT

           IF $GET(TVIEN)

               FOR 

                   SET Z=$ORDER(^AUPNVMSR("AD",TVIEN,Z),-1)

                   IF 'Z

                       QUIT 

                   IF +$GET(^AUPNVMSR(Z,0))=ASQM

                       SET OLD=1

                       QUIT 

 +11      ; NO CURRENT ROW: NEW ROW ADDED + OLD DATA

           IF 'OLD

               DO T1(DFN,DATE,TVIEN,.TODAY,.START,.FIN)

               SET EDIT=1003

               GOTO OUT

 +12      ; AT THIS POINT WE KNOW THERE IS ASQ DATA ASSOCIATED WITH THE CURRENT VISIT

 +13      ; GET CURRENT ASQ 

           SET X=$ORDER(^AUPNVMSR("AA",DFN,+ASQM,0))

 +14      ; CURRENT VISIT IS NOT THE MOST RECENT ASQ VISIT: CURRENT ROW IS LOCKED  - ALLOW OLD DATA ONLY

           IF ((9999999-X)\1)<VDT

               SET EDIT=1001

               GOTO OUT

 +15      ; CURRENT ROW IS EDITABLE (CURRENT ROW IS PART OF OLD DATA SET)

           SET EDIT=1004

OUT       ; GET TABLE GEN STRING FOR THIS ASQ MEASUREMENT

           SET OUT="BMX ADO SS^VEN ASQ TX^^~"_START_"~"_FIN_"~"_EDIT

 +1        DO ^XBFMK

 +2       ; THE VARIABLE 'TABLE' TELLS THE OBJECT WHAT CAN BE DONE: 1001=OLD VALUES ONLY,1002=NEW VALUE ONLY,1003=OLD AND 1 NEW ROW,1004=OLD WITH 1 EDITABLE ROW

 +3        QUIT 

 +4       ;

T1(DFN,DATE,TVIEN,TODAY,START,FIN) ; BUILD NEW ROW

 +1        SET TODAY=""

           SET START=$GET(START)

           SET FIN=$GET(FIN)

 +2        IF $GET(DATE)

               IF $GET(DFN)

 +3       IF '$TEST

               QUIT 

 +4        NEW X,Y,Z,%,DOB,EDOB,MOS2,ADOB,GA,ASQ2,FC2,GC2,CC2,SC2,DATE2,DIC,DIE,DA,DR,M,QIEN

 +5       ; ADJUSTED (ASQ) AGE IN MOS

           SET M=$$ASQAGE^VENPCCQ(DFN,DATE)

           IF 'M

               QUIT 

 +6       ; QUESTIONNAIRE IEN

           SET QIEN=+$$ASQIEN^VENPCCQ(M)

           IF 'QIEN

               QUIT 

 +7        SET DOB=$PIECE($GET(^DPT(DFN,0)),U,3)

 +8       ; PRINTED DOB

           SET EDOB=$$FMTE^XLFDT(DOB,"2D")

 +9       ; CHRONOLICAL AGE IN MONTHS

           SET MOS2=$$DOBAGE^VENPCCQ(DFN,DATE)

 +10      ; ADJUSTED (ASQ) DOB

           SET ADOB=$$ASQDOB^VENPCCQ(DFN)

 +11       IF ADOB

               SET ADOB=$$FMTE^XLFDT(ADOB,"2D")

 +12      ; GESTATIONAL AGE FROM BIRTH MEASUREMENT FILE

           SET GA=$PIECE($GET(^AUPNBMSR(DFN,0)),U,6)

 +13       SET %=$GET(^VEN(7.14,QIEN,0))

           IF '$LENGTH(%)

               QUIT 

 +14      ; QUESTIONNAIRE (MONTH)

           SET ASQ2=$PIECE(%,U,1)

 +15      ; FINE MOTOR CUTOFF