VENPCCQ2 ; IHS/OIT/GIS - ASQ GUI DATA CAPTURE: ENTER HISTORICAL RESULTS ; 10 Sep 2011 11:26 AM
;;2.6;PCC+;**3,4**;APR 03, 2012;Build 24
;
;
D HXASQ(.OUT,"15749|5/15/2011|48|2206155|3") W !,OUT Q
D HXFLUSH(.OUT,"~1~1~1002") Q
;
HXASQ(OUT,IN) ; RPC: VEN ASQ INIT HX RESULTS ; SET UP ENTRY OF HISTORICAL ASQ RESULTS
S OUT="ERROR: Missing/invalid input parameters"
I $G(IN)'=""
E Q
N DFN,EDT,ASQ,X,Y,Z,TDT,%,QIEN,TAGE,START,FIN,DATE,TVIEN,VER,%DT,VDT
S DFN=+IN I 'DFN Q
S EDT=$P(IN,"|",2) I EDT="" Q ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - EXTERNAL FORMAT
S ASQ=$P(IN,"|",3) I 'ASQ Q ; ASQ FORM 2-60
S TVIEN=$P(IN,"|",4) I 'TVIEN Q ; ORIGINATING VISIT IEN WHEN ASQ WAS ORDERED - MANDATORY
S VDT=+$G(^AUPNVSIT(TVIEN,0)) I 'VDT Q
S VER=$P(IN,"|",5) I 'VER Q ; ASQ VERSION 1-3
I VER<3,(ASQ=2!(ASQ=9)) S OUT="ERROR: ASQ Questionnaire "_ASQ_" is not included in ASQ Version "_VER_". Update denied." Q
S X=EDT,%DT="ETP"
S %DT=""
D ^%DT I Y=-1 Q
S TDT=Y\1 ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - INTERNAL FORMAT
I TDT<VDT S OUT="ERROR: Date of ASQ testing can not be earlier than the visit date" Q
S QIEN=$O(^VEN(7.14,"B",ASQ,0)) I 'QIEN Q
S TAGE=$$ASQAGE^VENPCCQ(DFN,TDT) I 'TAGE Q
S %=$G(^VEN(7.14,QIEN,2)) I %="" Q
S START=+% I 'START Q
S FIN=$P(%,U,2) I 'FIN Q
I TAGE<START!(TAGE>FIN) S OUT="ERROR: The ASQ Questionnaire does not match the child's age on the date of testing. Update denied." Q
HXCLEAN 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 DATE=TDT,LOCK="",TXIEN=""
D T1(DFN,QIEN,TDT,TVIEN,VER,.LOCK,.TXIEN) ; CREATE AN ENTRY IN ASQ TX FILE FOR THE HISTORICAL VISIT
I LOCK S OUT="ERROR: ASQ scores for this test date are locked and can not be edited" Q
I 'TXIEN S OUT="ERROR: Unabe to capture historical results" Q
S OUT="BMX ADO SS^VEN ASQ TX^^~"_TXIEN_"~"_TXIEN_"~1002" ; GET TABLE GEN STRING FOR THIS ASQ MEASUREMENT
Q
;
T1(DFN,QIEN,DATE,TVIEN,VER,LOCK,TXIEN) ; GET HISTORICAL ASQ VALUES
S TODAY="",TXIEN=""
I $G(QIEN),$G(DFN),$G(VER)
E Q
N X,Y,Z,%,DOB,EDOB,MOS2,ADOB,GA,ASQ2,FC2,GC2,CC2,SC2,DATE2,DIC,DIE,DA,DR,VERIEN,IEN,REDT,STOP
S DOB=$P($G(^DPT(DFN,0)),U,3)
S EDOB=$$FMTE^XLFDT(DOB,"2D") ; PRINTED DOB
S MOS2=$$DOBAGE^VENPCCQ(DOB,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 VERIEN=$O(^VEN(7.14,QIEN,3,"B",VER,0)) I 'VERIEN Q ; ASQ VERSION IEN
S ASQ2=$P($G(^VEN(7.14,QIEN,0)),U) I 'ASQ2 Q ; QUESTIONNAIRE (MONTH)
S %=$G(^VEN(7.14,QIEN,3,VERIEN,0)) I '$L(%) Q ; VERSION-SPECIFIC CUTOFF SCORE STRING
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 TXIEN="" D ^XBFMK Q
S TXIEN=+Y ; IEN IN THE ASQ TX FILE FOR TODAY'S NEW ENTRY
STUFF S IEN="",LOCK="",REDT=""
F TYPE="M","F","G","L","S","P" D Q:LOCK Q:'REDT ; LOOP THROUGH ALL ASQ MEASUREMENT TYPES
. S @TYPE="",STOP=0
. S MIEN=$O(^AUTTMSR("B","ASQ"_TYPE,0)) I 'MIEN Q
. F S IEN=$O(^AUPNVMSR("AD",TVIEN,IEN)) Q:'IEN D I STOP Q ; LOOP THROUGH ALL THE VISIT'S MEASUREMENTS UNTIL MEASUREMENT TYPE MATCHES
.. S %=+$G(^AUPNVMSR(IEN,0))
.. I %'=MIEN Q ; NOT THE RIGHT TYPE, KEEP LOOKING
.. S STOP=1 ; TYPES MATCH. PROCESS THE RECORD AND QUIT LOOKING
.. I TYPE="M" D Q ; CHECK FOR EXISTING RESULTS CAPTURED ON THE TEST DATE AND TIME SINCE RESULTS WERE ACTUALLY ENTERED
... S %=$P($G(^AUPNVMSR(IEN,12)),U) ; EVENT DATE; I.E., DATE WHEN TEST WAS ADMINISTERED
... I %'=DATE Q ; TEST DATE IN V MEASUREMENT MUST MATCH ASQ TEST DATE IN TX FILE TO EDIT OLD VALUES - OTHERWISE FORCE FRESH DATA SET
... S REDT=+$P($G(^AUPNVMSR(IEN,0)),U,7) S REDT=REDT\1 ; DATE RESULTS ENTERED INTO RPMS
... I $$FMDIFF^XLFDT(DT,REDT)>3 S LOCK=1 Q ; RESULTS ALREDY ENTERED FOR TEST DATE, BUT UPDATE NOT ALLOWED: >72 HRS FROM ORIGINAL ENTRY
... Q
.. S %=$P($G(^AUPNVMSR(IEN,0)),U,4)
.. S @TYPE=$S($L(%):$P(%," "),1:"*")
.. Q
. Q
FINISH I LOCK D ^XBFMK Q
S ^VEN(7.15,TXIEN,0)=DFN_U_DATE2_U_ASQ2_U_MOS2_U_EDOB_U_ADOB_U_GA_U_TVIEN
I REDT S ^VEN(7.15,TXIEN,1)=U_FC2_U_G_U_GC2_U_L_U_CC2_U_S_U_SC2_U_P_U_PC2_U_F
E S ^VEN(7.15,TXIEN,1)=U_FC2_U_"*"_U_GC2_U_"*"_U_CC2_U_"*"_U_SC2_U_"*"_U_PC2_U_"*"
D ^XBFMK
Q
;
HXFLUSH(OUT,IN) ; RPC: VEN ASQ FLUSH HX RESULTS ; FLUSH HISTORICAL RESULTS
; THIS EXPECTS/FLUSHES A SINGLE ENTRY IN THE ASQ TX FILE AND THEN DELETES THE ENTRY
; AFTER CALLING THIS, RESENT THE RPC: VEN ASQ START TX
S OUT="ERROR: Missing/invalid input parameters"
I $G(IN)'=""
E Q
N X,Y,Z,%,TXIEN,HXVIEN,PRVIEN,VDT,EDT,EXDT,RDT,VIEN,PRVIEN,ASQ,ASQIEN,STG,PCE,V1,V2,VSTG,GBL
N F,FC,G,GC,C,CC,S,SC,P,PC,DIC,DIE,DA,DR,DLAYGO,DIK
S TXIEN=+$P(IN,"~",2) I 'TXIEN Q
S PRVIEN=$P(IN,"~",5) I 'PRVIEN Q
S %=$G(^VEN(7.15,TXIEN,0)) I %="" Q
S VIEN=$P(%,U,8)\1 I 'VIEN Q ; DATE ASQ ORDERED (ORIGINATING VISIT DATE)
S RDT=+$G(DT) I 'RDT Q ; DATE RESULTS RECORDED
S DFN=+% I 'DFN Q
S ASQ=$P(%,U,3) I 'ASQ Q ; NAME OF ASQ FORM
S ASQIEN=$O(^VEN(7.14,"B",+$G(ASQ),0))
I 'ASQIEN D ASQCLEAN^VENPCCQ1(VIEN) S OUT="OK" Q ; ASQ FORM NOT DEFINED, SO DELETE ALL OF THE VISIT'S ASQ RESULTS AND QUIT
S EXDT=$P(%,U,2) I EXDT="" Q ; EVENT DATE (DATE ASQ ADMINISTERED) IN EXTERNAL FORMAT
S X=EXDT,%DT="" D ^%DT S EDT=Y\1
FL1 S STG=$G(^VEN(7.15,TXIEN,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
MEAS ; V MEASUREMENTS ENTRY
I $P(VSTG,U,7) F PCE=7,1:1:5 S VAL=$P(VSTG,U,PCE) S:VAL="" VAL="@" D ASQVMSR^VENPCCQ1(PCE,VAL,VIEN,"",PRVIEN,EDT,RDT) ; MAKE INDIVIDUAL V MEAS ENTRIES
TXCLEAN S DIK="^VEN(7.15,",DA="" ; CLEAN UP THE TX FILE
F S DA=$O(^VEN(7.15,"B",DFN,DA)) Q:'DA I $D(^VEN(7.15,DA)) D ^DIK
S OUT="OK"
D ^XBFMK
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
;
FORMS(OUT,IN) ; RPC: VEN ASQ FORMS ; GIVEN A VERSION, RETURN A STRING WITH THE SET OF ASQ FORMS
S OUT="ERROR: Invalid/missing version parameter"
I $G(IN),IN=IN\1,IN<4
E Q
I IN=3 S OUT="2|4|6|8|9|10|12|14|16|18|20|22|24|27|30|33|36|42|48|54|60"
I IN<3 S OUT="4|6|8|10|12|14|16|18|20|22|24|27|30|33|36|42|48|54|60"
Q
;
VENPCCQ2 ; IHS/OIT/GIS - ASQ GUI DATA CAPTURE: ENTER HISTORICAL RESULTS ; 10 Sep 2011 11:26 AM
+1 ;;2.6;PCC+;**3,4**;APR 03, 2012;Build 24
+2 ;
+3 ;
+4 DO HXASQ(.OUT,"15749|5/15/2011|48|2206155|3")
WRITE !,OUT
QUIT
+5 DO HXFLUSH(.OUT,"~1~1~1002")
QUIT
+6 ;
HXASQ(OUT,IN) ; RPC: VEN ASQ INIT HX RESULTS ; SET UP ENTRY OF HISTORICAL ASQ RESULTS
+1 SET OUT="ERROR: Missing/invalid input parameters"
+2 IF $GET(IN)'=""
+3 IF '$TEST
QUIT
+4 NEW DFN,EDT,ASQ,X,Y,Z,TDT,%,QIEN,TAGE,START,FIN,DATE,TVIEN,VER,%DT,VDT
+5 SET DFN=+IN
IF 'DFN
QUIT
+6 ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - EXTERNAL FORMAT
SET EDT=$PIECE(IN,"|",2)
IF EDT=""
QUIT
+7 ; ASQ FORM 2-60
SET ASQ=$PIECE(IN,"|",3)
IF 'ASQ
QUIT
+8 ; ORIGINATING VISIT IEN WHEN ASQ WAS ORDERED - MANDATORY
SET TVIEN=$PIECE(IN,"|",4)
IF 'TVIEN
QUIT
+9 SET VDT=+$GET(^AUPNVSIT(TVIEN,0))
IF 'VDT
QUIT
+10 ; ASQ VERSION 1-3
SET VER=$PIECE(IN,"|",5)
IF 'VER
QUIT
+11 IF VER<3
IF (ASQ=2!(ASQ=9))
SET OUT="ERROR: ASQ Questionnaire "_ASQ_" is not included in ASQ Version "_VER_". Update denied."
QUIT
+12 SET X=EDT
SET %DT="ETP"
+13 SET %DT=""
+14 DO ^%DT
IF Y=-1
QUIT
+15 ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - INTERNAL FORMAT
SET TDT=Y\1
+16 IF TDT<VDT
SET OUT="ERROR: Date of ASQ testing can not be earlier than the visit date"
QUIT
+17 SET QIEN=$ORDER(^VEN(7.14,"B",ASQ,0))
IF 'QIEN
QUIT
+18 SET TAGE=$$ASQAGE^VENPCCQ(DFN,TDT)
IF 'TAGE
QUIT
+19 SET %=$GET(^VEN(7.14,QIEN,2))
IF %=""
QUIT
+20 SET START=+%
IF 'START
QUIT
+21 SET FIN=$PIECE(%,U,2)
IF 'FIN
QUIT
+22 IF TAGE<START!(TAGE>FIN)
SET OUT="ERROR: The ASQ Questionnaire does not match the child's age on the date of testing. Update denied."
QUIT
HXCLEAN 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 SET DATE=TDT
SET LOCK=""
SET TXIEN=""
+3 ; CREATE AN ENTRY IN ASQ TX FILE FOR THE HISTORICAL VISIT
DO T1(DFN,QIEN,TDT,TVIEN,VER,.LOCK,.TXIEN)
+4 IF LOCK
SET OUT="ERROR: ASQ scores for this test date are locked and can not be edited"
QUIT
+5 IF 'TXIEN
SET OUT="ERROR: Unabe to capture historical results"
QUIT
+6 ; GET TABLE GEN STRING FOR THIS ASQ MEASUREMENT
SET OUT="BMX ADO SS^VEN ASQ TX^^~"_TXIEN_"~"_TXIEN_"~1002"
+7 QUIT
+8 ;
T1(DFN,QIEN,DATE,TVIEN,VER,LOCK,TXIEN) ; GET HISTORICAL ASQ VALUES
+1 SET TODAY=""
SET TXIEN=""
+2 IF $GET(QIEN)
IF $GET(DFN)
IF $GET(VER)
+3 IF '$TEST
QUIT
+4 NEW X,Y,Z,%,DOB,EDOB,MOS2,ADOB,GA,ASQ2,FC2,GC2,CC2,SC2,DATE2,DIC,DIE,DA,DR,VERIEN,IEN,REDT,STOP
+5 SET DOB=$PIECE($GET(^DPT(DFN,0)),U,3)
+6 ; PRINTED DOB
SET EDOB=$$FMTE^XLFDT(DOB,"2D")
+7 ; CHRONOLICAL AGE IN MONTHS
SET MOS2=$$DOBAGE^VENPCCQ(DOB,DATE)
+8 ; ADJUSTED (ASQ) DOB
SET ADOB=$$ASQDOB^VENPCCQ(DFN)
+9 IF ADOB
SET ADOB=$$FMTE^XLFDT(ADOB,"2D")
+10 ; GESTATIONAL AGE FROM BIRTH MEASUREMENT FILE
SET GA=$PIECE($GET(^AUPNBMSR(DFN,0)),U,6)
+11 ; ASQ VERSION IEN
SET VERIEN=$ORDER(^VEN(7.14,QIEN,3,"B",VER,0))
IF 'VERIEN
QUIT
+12 ; QUESTIONNAIRE (MONTH)
SET ASQ2=$PIECE($GET(^VEN(7.14,QIEN,0)),U)
IF 'ASQ2
QUIT
+13 ; VERSION-SPECIFIC CUTOFF SCORE STRING
SET %=$GET(^VEN(7.14,QIEN,3,VERIEN,0))
IF '$LENGTH(%)
QUIT
+14 ; FINE MOTOR CUTOFF
SET FC2=$PIECE(%,U,4)
+15 ; GROSS MOTOR CUTOFF
SET GC2=$PIECE(%,U,3)
+16 ; COMMUNICATION CUTOFF
SET CC2=$PIECE(%,U,2)
+17 ; PERSONAL-SOCIAL CUTOFF
SET SC2=$PIECE(%,U,6)
+18 ; PROBLEM SOLVING CUTOFF
SET PC2=$PIECE(%,U,5)
+19 SET DATE2=$$FMTE^XLFDT(DATE,"2D")
+20 SET DIC="^VEN(7.15,"
SET DIC(0)="L"
SET DLAYGO=19707.15
SET X=""""_DFN_""""
+21 DO ^DIC
IF Y=-1
SET TXIEN=""
DO ^XBFMK
QUIT
+22 ; IEN IN THE ASQ TX FILE FOR TODAY'S NEW ENTRY
SET TXIEN=+Y
STUFF SET IEN=""
SET LOCK=""
SET REDT=""
+1 ; LOOP THROUGH ALL ASQ MEASUREMENT TYPES
FOR TYPE="M","F","G","L","S","P"
Begin DoDot:1
+2 SET @TYPE=""
SET STOP=0
+3 SET MIEN=$ORDER(^AUTTMSR("B","ASQ"_TYPE,0))
IF 'MIEN
QUIT
+4 ; LOOP THROUGH ALL THE VISIT'S MEASUREMENTS UNTIL MEASUREMENT TYPE MATCHES
FOR
SET IEN=$ORDER(^AUPNVMSR("AD",TVIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+5 SET %=+$GET(^AUPNVMSR(IEN,0))
+6 ; NOT THE RIGHT TYPE, KEEP LOOKING
IF %'=MIEN
QUIT
+7 ; TYPES MATCH. PROCESS THE RECORD AND QUIT LOOKING
SET STOP=1
+8 ; CHECK FOR EXISTING RESULTS CAPTURED ON THE TEST DATE AND TIME SINCE RESULTS WERE ACTUALLY ENTERED
IF TYPE="M"
Begin DoDot:3
+9 ; EVENT DATE; I.E., DATE WHEN TEST WAS ADMINISTERED
SET %=$PIECE($GET(^AUPNVMSR(IEN,12)),U)
+10 ; TEST DATE IN V MEASUREMENT MUST MATCH ASQ TEST DATE IN TX FILE TO EDIT OLD VALUES - OTHERWISE FORCE FRESH DATA SET
IF %'=DATE
QUIT
+11 ; DATE RESULTS ENTERED INTO RPMS
SET REDT=+$PIECE($GET(^AUPNVMSR(IEN,0)),U,7)
SET REDT=REDT\1
+12 ; RESULTS ALREDY ENTERED FOR TEST DATE, BUT UPDATE NOT ALLOWED: >72 HRS FROM ORIGINAL ENTRY
IF $$FMDIFF^XLFDT(DT,REDT)>3
SET LOCK=1
QUIT
+13 QUIT
End DoDot:3
QUIT
+14 SET %=$PIECE($GET(^AUPNVMSR(IEN,0)),U,4)
+15 SET @TYPE=$SELECT($LENGTH(%):$PIECE(%," "),1:"*")
+16 QUIT
End DoDot:2
IF STOP
QUIT
+17 QUIT
End DoDot:1
IF LOCK
QUIT
IF 'REDT
QUIT
FINISH IF LOCK
DO ^XBFMK
QUIT
+1 SET ^VEN(7.15,TXIEN,0)=DFN_U_DATE2_U_ASQ2_U_MOS2_U_EDOB_U_ADOB_U_GA_U_TVIEN
+2 IF REDT
SET ^VEN(7.15,TXIEN,1)=U_FC2_U_G_U_GC2_U_L_U_CC2_U_S_U_SC2_U_P_U_PC2_U_F
+3 IF '$TEST
SET ^VEN(7.15,TXIEN,1)=U_FC2_U_"*"_U_GC2_U_"*"_U_CC2_U_"*"_U_SC2_U_"*"_U_PC2_U_"*"
+4 DO ^XBFMK
+5 QUIT
+6 ;
HXFLUSH(OUT,IN) ; RPC: VEN ASQ FLUSH HX RESULTS ; FLUSH HISTORICAL RESULTS
+1 ; THIS EXPECTS/FLUSHES A SINGLE ENTRY IN THE ASQ TX FILE AND THEN DELETES THE ENTRY
+2 ; AFTER CALLING THIS, RESENT THE RPC: VEN ASQ START TX
+3 SET OUT="ERROR: Missing/invalid input parameters"
+4 IF $GET(IN)'=""
+5 IF '$TEST
QUIT
+6 NEW X,Y,Z,%,TXIEN,HXVIEN,PRVIEN,VDT,EDT,EXDT,RDT,VIEN,PRVIEN,ASQ,ASQIEN,STG,PCE,V1,V2,VSTG,GBL
+7 NEW F,FC,G,GC,C,CC,S,SC,P,PC,DIC,DIE,DA,DR,DLAYGO,DIK
+8 SET TXIEN=+$PIECE(IN,"~",2)
IF 'TXIEN
QUIT
+9 SET PRVIEN=$PIECE(IN,"~",5)
IF 'PRVIEN
QUIT
+10 SET %=$GET(^VEN(7.15,TXIEN,0))
IF %=""
QUIT
+11 ; DATE ASQ ORDERED (ORIGINATING VISIT DATE)
SET VIEN=$PIECE(%,U,8)\1
IF 'VIEN
QUIT
+12 ; DATE RESULTS RECORDED
SET RDT=+$GET(DT)
IF 'RDT
QUIT
+13 SET DFN=+%
IF 'DFN
QUIT
+14 ; NAME OF ASQ FORM
SET ASQ=$PIECE(%,U,3)
IF 'ASQ
QUIT
+15 SET ASQIEN=$ORDER(^VEN(7.14,"B",+$GET(ASQ),0))
+16 ; ASQ FORM NOT DEFINED, SO DELETE ALL OF THE VISIT'S ASQ RESULTS AND QUIT
IF 'ASQIEN
DO ASQCLEAN^VENPCCQ1(VIEN)
SET OUT="OK"
QUIT
+17 ; EVENT DATE (DATE ASQ ADMINISTERED) IN EXTERNAL FORMAT
SET EXDT=$PIECE(%,U,2)
IF EXDT=""
QUIT
+18 SET X=EXDT
SET %DT=""
DO ^%DT
SET EDT=Y\1
FL1 SET STG=$GET(^VEN(7.15,TXIEN,1))
IF '$LENGTH(STG)
QUIT
+1 FOR PCE=1:1:5
Begin DoDot:1
+2 SET %=$EXTRACT("FGCSP",PCE)
+3 SET V1=%
SET V2=%_"C"
+4 IF PCE=1
SET X=$PIECE(STG,U,11)
SET Y=$PIECE(STG,U,2)
+5 IF '$TEST
SET Z=(PCE*2)-1
SET X=$PIECE(STG,U,Z)
SET Y=$PIECE(STG,U,Z+1)
+6 SET Y=$TRANSLATE(Y,"(","")
SET Y=$TRANSLATE(Y,")","")
+7 SET @V1=X
SET @V2=Y
+8 QUIT
End DoDot:1
+9 SET VSTG=F_" ("_FC_")^"_G_" ("_GC_")^"_C_" ("_CC_")^"_S_" ("_SC_")^"_P_" ("_PC_")^^"_ASQ
MEAS ; V MEASUREMENTS ENTRY
+1 ; MAKE INDIVIDUAL V MEAS ENTRIES
IF $PIECE(VSTG,U,7)
FOR PCE=7,1:1:5
SET VAL=$PIECE(VSTG,U,PCE)
IF VAL=""
SET VAL="@"
DO ASQVMSR^VENPCCQ1(PCE,VAL,VIEN,"",PRVIEN,EDT,RDT)
TXCLEAN ; CLEAN UP THE TX FILE
SET DIK="^VEN(7.15,"
SET DA=""
+1 FOR
SET DA=$ORDER(^VEN(7.15,"B",DFN,DA))
IF 'DA
QUIT
IF $DATA(^VEN(7.15,DA))
DO ^DIK
+2 SET OUT="OK"
+3 DO ^XBFMK
+4 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 ;
FORMS(OUT,IN) ; RPC: VEN ASQ FORMS ; GIVEN A VERSION, RETURN A STRING WITH THE SET OF ASQ FORMS
+1 SET OUT="ERROR: Invalid/missing version parameter"
+2 IF $GET(IN)
IF IN=IN\1
IF IN<4
+3 IF '$TEST
QUIT
+4 IF IN=3
SET OUT="2|4|6|8|9|10|12|14|16|18|20|22|24|27|30|33|36|42|48|54|60"
+5 IF IN<3
SET OUT="4|6|8|10|12|14|16|18|20|22|24|27|30|33|36|42|48|54|60"
+6 QUIT
+7 ;
