Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VENPCCQ2

VENPCCQ2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  D HXASQ(.OUT,"15749|5/15/2011|48|2206155|3") W !,OUT Q
  1.  D HXFLUSH(.OUT,"~1~1~1002") Q
  1.  ;
  1. HXASQ(OUT,IN) ; RPC: VEN ASQ INIT HX RESULTS ; SET UP ENTRY OF HISTORICAL ASQ RESULTS
  1.  S OUT="ERROR: Missing/invalid input parameters"
  1.  I $G(IN)'=""
  1.  E  Q
  1.  N DFN,EDT,ASQ,X,Y,Z,TDT,%,QIEN,TAGE,START,FIN,DATE,TVIEN,VER,%DT,VDT
  1.  S DFN=+IN I 'DFN Q
  1.  S EDT=$P(IN,"|",2) I EDT="" Q  ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - EXTERNAL FORMAT
  1.  S ASQ=$P(IN,"|",3) I 'ASQ Q  ; ASQ FORM 2-60
  1.  S TVIEN=$P(IN,"|",4) I 'TVIEN Q  ; ORIGINATING VISIT IEN WHEN ASQ WAS ORDERED - MANDATORY
  1.  S VDT=+$G(^AUPNVSIT(TVIEN,0)) I 'VDT Q
  1.  S VER=$P(IN,"|",5) I 'VER Q  ; ASQ VERSION 1-3
  1.  I VER<3,(ASQ=2!(ASQ=9)) S OUT="ERROR: ASQ Questionnaire "_ASQ_" is not included in ASQ Version "_VER_". Update denied." Q
  1.  S X=EDT,%DT="ETP"
  1.  S %DT=""
  1.  D ^%DT I Y=-1 Q
  1.  S TDT=Y\1 ; EVENT DATE WHEN TEST ACTUALLY ADMINISTERED - INTERNAL FORMAT
  1.  I TDT<VDT S OUT="ERROR: Date of ASQ testing can not be earlier than the visit date" Q
  1.  S QIEN=$O(^VEN(7.14,"B",ASQ,0)) I 'QIEN Q
  1.  S TAGE=$$ASQAGE^VENPCCQ(DFN,TDT) I 'TAGE Q
  1.  S %=$G(^VEN(7.14,QIEN,2)) I %="" Q
  1.  S START=+% I 'START Q
  1.  S FIN=$P(%,U,2) I 'FIN Q
  1.  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
  1. HXCLEAN S DIK="^VEN(7.15,",DA=0
  1.  F  S DA=$O(^VEN(7.15,"B",DFN,DA)) Q:'DA  D ^DIK ; DELETE ALL ASQ TX FILE ENTRIES FOR THIS PATIENT
  1.  S DATE=TDT,LOCK="",TXIEN=""
  1.  D T1(DFN,QIEN,TDT,TVIEN,VER,.LOCK,.TXIEN) ; CREATE AN ENTRY IN ASQ TX FILE FOR THE HISTORICAL VISIT
  1.  I LOCK S OUT="ERROR: ASQ scores for this test date are locked and can not be edited" Q
  1.  I 'TXIEN S OUT="ERROR: Unabe to capture historical results" Q
  1.  S OUT="BMX ADO SS^VEN ASQ TX^^~"_TXIEN_"~"_TXIEN_"~1002" ; GET TABLE GEN STRING FOR THIS ASQ MEASUREMENT
  1.  Q
  1.  ;
  1. T1(DFN,QIEN,DATE,TVIEN,VER,LOCK,TXIEN) ; GET HISTORICAL ASQ VALUES
  1.  S TODAY="",TXIEN=""
  1.  I $G(QIEN),$G(DFN),$G(VER)
  1.  E  Q
  1.  N X,Y,Z,%,DOB,EDOB,MOS2,ADOB,GA,ASQ2,FC2,GC2,CC2,SC2,DATE2,DIC,DIE,DA,DR,VERIEN,IEN,REDT,STOP
  1.  S DOB=$P($G(^DPT(DFN,0)),U,3)
  1.  S EDOB=$$FMTE^XLFDT(DOB,"2D") ; PRINTED DOB
  1.  S MOS2=$$DOBAGE^VENPCCQ(DOB,DATE) ; CHRONOLICAL AGE IN MONTHS
  1.  S ADOB=$$ASQDOB^VENPCCQ(DFN) ; ADJUSTED (ASQ) DOB
  1.  I ADOB S ADOB=$$FMTE^XLFDT(ADOB,"2D")
  1.  S GA=$P($G(^AUPNBMSR(DFN,0)),U,6) ; GESTATIONAL AGE FROM BIRTH MEASUREMENT FILE
  1.  S VERIEN=$O(^VEN(7.14,QIEN,3,"B",VER,0)) I 'VERIEN Q  ; ASQ VERSION IEN
  1.  S ASQ2=$P($G(^VEN(7.14,QIEN,0)),U) I 'ASQ2 Q  ; QUESTIONNAIRE (MONTH)
  1.  S %=$G(^VEN(7.14,QIEN,3,VERIEN,0)) I '$L(%) Q  ; VERSION-SPECIFIC CUTOFF SCORE STRING
  1.  S FC2=$P(%,U,4) ; FINE MOTOR CUTOFF
  1.  S GC2=$P(%,U,3) ; GROSS MOTOR CUTOFF
  1.  S CC2=$P(%,U,2) ; COMMUNICATION CUTOFF
  1.  S SC2=$P(%,U,6) ; PERSONAL-SOCIAL CUTOFF
  1.  S PC2=$P(%,U,5) ; PROBLEM SOLVING CUTOFF
  1.  S DATE2=$$FMTE^XLFDT(DATE,"2D")
  1.  S DIC="^VEN(7.15,",DIC(0)="L",DLAYGO=19707.15,X=""""_DFN_""""
  1.  D ^DIC I Y=-1 S TXIEN="" D ^XBFMK Q
  1.  S TXIEN=+Y ; IEN IN THE ASQ TX FILE FOR TODAY'S NEW ENTRY
  1. STUFF S IEN="",LOCK="",REDT=""
  1.  F TYPE="M","F","G","L","S","P" D  Q:LOCK  Q:'REDT  ; LOOP THROUGH ALL ASQ MEASUREMENT TYPES
  1.  . S @TYPE="",STOP=0
  1.  . S MIEN=$O(^AUTTMSR("B","ASQ"_TYPE,0)) I 'MIEN Q
  1.  . 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
  1.  .. S %=+$G(^AUPNVMSR(IEN,0))
  1.  .. I %'=MIEN Q  ; NOT THE RIGHT TYPE, KEEP LOOKING
  1.  .. S STOP=1 ; TYPES MATCH. PROCESS THE RECORD AND QUIT LOOKING
  1.  .. I TYPE="M" D  Q  ; CHECK FOR EXISTING RESULTS CAPTURED ON THE TEST DATE AND TIME SINCE RESULTS WERE ACTUALLY ENTERED
  1.  ... S %=$P($G(^AUPNVMSR(IEN,12)),U) ; EVENT DATE; I.E., DATE WHEN TEST WAS ADMINISTERED
  1.  ... 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
  1.  ... S REDT=+$P($G(^AUPNVMSR(IEN,0)),U,7) S REDT=REDT\1 ; DATE RESULTS ENTERED INTO RPMS
  1.  ... 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
  1.  ... Q
  1.  .. S %=$P($G(^AUPNVMSR(IEN,0)),U,4)
  1.  .. S @TYPE=$S($L(%):$P(%," "),1:"*")
  1.  .. Q
  1.  . Q
  1. FINISH I LOCK D ^XBFMK Q
  1.  S ^VEN(7.15,TXIEN,0)=DFN_U_DATE2_U_ASQ2_U_MOS2_U_EDOB_U_ADOB_U_GA_U_TVIEN
  1.  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
  1.  E  S ^VEN(7.15,TXIEN,1)=U_FC2_U_"*"_U_GC2_U_"*"_U_CC2_U_"*"_U_SC2_U_"*"_U_PC2_U_"*"
  1.  D ^XBFMK
  1.  Q
  1.  ; 
  1. 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
  1.  ; AFTER CALLING THIS, RESENT THE RPC: VEN ASQ START TX
  1.  S OUT="ERROR: Missing/invalid input parameters"
  1.  I $G(IN)'=""
  1.  E  Q
  1.  N X,Y,Z,%,TXIEN,HXVIEN,PRVIEN,VDT,EDT,EXDT,RDT,VIEN,PRVIEN,ASQ,ASQIEN,STG,PCE,V1,V2,VSTG,GBL
  1.  N F,FC,G,GC,C,CC,S,SC,P,PC,DIC,DIE,DA,DR,DLAYGO,DIK
  1.  S TXIEN=+$P(IN,"~",2) I 'TXIEN Q
  1.  S PRVIEN=$P(IN,"~",5) I 'PRVIEN Q
  1.  S %=$G(^VEN(7.15,TXIEN,0)) I %="" Q
  1.  S VIEN=$P(%,U,8)\1 I 'VIEN Q  ; DATE ASQ ORDERED (ORIGINATING VISIT DATE)
  1.  S RDT=+$G(DT) I 'RDT Q  ; DATE RESULTS RECORDED
  1.  S DFN=+% I 'DFN Q
  1.  S ASQ=$P(%,U,3) I 'ASQ Q  ; NAME OF ASQ FORM
  1.  S ASQIEN=$O(^VEN(7.14,"B",+$G(ASQ),0))
  1.  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
  1.  S EXDT=$P(%,U,2) I EXDT="" Q  ; EVENT DATE (DATE ASQ ADMINISTERED) IN EXTERNAL FORMAT
  1.  S X=EXDT,%DT="" D ^%DT S EDT=Y\1
  1. FL1 S STG=$G(^VEN(7.15,TXIEN,1)) I '$L(STG) Q
  1.  F PCE=1:1:5 D
  1.  . S %=$E("FGCSP",PCE)
  1.  . S V1=%,V2=%_"C"
  1.  . I PCE=1 S X=$P(STG,U,11),Y=$P(STG,U,2)
  1.  . E  S Z=(PCE*2)-1,X=$P(STG,U,Z),Y=$P(STG,U,Z+1)
  1.  . S Y=$TR(Y,"(",""),Y=$TR(Y,")","")
  1.  . S @V1=X,@V2=Y
  1.  . Q
  1.  S VSTG=F_" ("_FC_")^"_G_" ("_GC_")^"_C_" ("_CC_")^"_S_" ("_SC_")^"_P_" ("_PC_")^^"_ASQ
  1. MEAS ; V MEASUREMENTS ENTRY
  1.  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
  1. TXCLEAN S DIK="^VEN(7.15,",DA="" ; CLEAN UP THE TX FILE
  1.  F  S DA=$O(^VEN(7.15,"B",DFN,DA)) Q:'DA  I $D(^VEN(7.15,DA)) D ^DIK
  1.  S OUT="OK"
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. VISIT(OUT,IN) ; EP - RPC: VEN ASQ GET VISITS
  1.  ; GIVEN DFN, RETURN PATIENT IDENTIFIERS AND CANDIDATE VISIT IDENTIFIERS
  1.  I '$D(^DPT(+$G(IN),0)) Q
  1.  N NAME,DOB,MOM,X,Y,%,AUPNPAT,AUPNSEX,AUPNDOB,AUPNDAYS,AUPNDOD,B,GA,DFN,TS,VSTG,CSIEN,CS
  1.  S OUT="",B="|",DFN=+IN
  1.  S DIC="^AUPNPAT(",X="`"_DFN,DIC(0)="M"
  1.  D PLK^VENPCCQ I OUT="" Q
  1.  S IDT=9999999-(DT\1),BDT=9999999-$$FMADD^XLFDT(DT,-365)
  1.  S IDT=IDT-.0000001,VSTG=""
  1.  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
  1.  . S X=$G(^AUPNVSIT(VIEN,0)) I '$L(X) Q
  1.  . S TS=$$FMTE^XLFDT(+X) I '$L(TS) Q
  1.  . S CSIEN=$P(X,U,8) I 'CSIEN Q
  1.  . S CS=$P($G(^DIC(40.7,CSIEN,0)),U) I '$L(CS) Q
  1.  . S VSTG=VSTG_"\"_VIEN_B_TS_B_CS
  1.  . Q
  1.  I $L($G(VSTG)) S OUT=OUT_VSTG
  1.  Q
  1.  ; 
  1. FORMS(OUT,IN) ; RPC: VEN ASQ FORMS ; GIVEN A VERSION, RETURN A STRING WITH THE SET OF ASQ FORMS
  1.  S OUT="ERROR: Invalid/missing version parameter"
  1.  I $G(IN),IN=IN\1,IN<4
  1.  E  Q
  1.  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"
  1.  I IN<3 S OUT="4|6|8|10|12|14|16|18|20|22|24|27|30|33|36|42|48|54|60"
  1.  Q
  1.  ;