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

BQIVFDEF.m

Go to the documentation of this file. 
  1. BQIVFDEF ;PRXM/HC/ALA - PCC V-file definition ; 22 Mar 2007  2:55 PM
  1.  ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
  1.  Q
  1.  ;
  1. EN(DATA,VFILE,TYPE) ;EP -- BQI GET VFILE DISPLAY
  1.  ;
  1.  ;Input
  1.  ;  VFILE - The vfile number or name
  1.  ;
  1.  NEW UID,II,IEN,VFIL,VALUE,ORD,VDATA,VDATA1,VDATA2,BJ,CLEAR,CLRFLD,CN
  1.  NEW HELP,VDATA3,VFILN,VHELP,BN,BQIHELP,BQIHELPW,VFLD,VDATA9
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIVFDEF",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFDEF D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S VFIEN=$G(VFILE,""),TYPE=$G(TYPE,"V")
  1.  ;
  1.  S HDR="T00030VFILE_NAME^T00015VFILE_NUMBER^T00030DISPLAY_RPC^T00045DISPLAY_RPC_PARAM^T00030EDIT_RPC^T00045EDIT_RPC_PARAM^T00030INIT_TRIGGER_RPC^"
  1.  S HDR=HDR_"T00045INIT_TRIG_PARAM^T00030DELETE_RPC^T00045DELETE_RPC_PARAM^T00001FILTER^T00030VALID_RPC^"
  1.  S HDR=HDR_"T00030DISPLAY_COLUMN^T00030INTERNAL_COLUMN^I00003SIZE^T00001COL_TYPE_PEND^T00001COL_TYPE_VIEW^T00008CODE^T00001GROUP^T00001CODE_TYPE^T00030UPPER^T00030LOWER^"
  1.  S HDR=HDR_"T00030DEFAULT^T00001ACTION^T00001REQ_OPT^T00036EXCLUSION^T00001UNIQUE_VAL^T00003BATCH^T00045VALIDATION^T00030VALID_INPUT^T00020TABLE^T00001TABLE_LOOKUP^T00001PROV_SCREEN^T00150TABLE_SCREEN^"
  1.  ;S HDR=HDR_"T00030DEFAULT^T00001ACTION^T00001REQ_OPT^T00036EXCLUSION^T00045VALIDATION^T00030VALID_INPUT^T00020TABLE^T00001TABLE_LOOKUP^T00001PROV_SCREEN^T00150TABLE_SCREEN^"
  1.  S HDR=HDR_"T00001TRIGGER^T00030TRIG_RPC^T00045TRIG_CODES^T00001TABLE_PRELOAD^T00001TABLE_LOOKUP_TYPE^T00003DEC_PLACES^T00030ALT_DISPLAY^T00030MULT_REF^T00045GROUP_NAME^I00003GRID_ORDER^"
  1.  S HDR=HDR_"T00030LINK_DATA_COL^T00045LINK_RPC^T00030LINK_PARAM^T00250CLEAR_FIELDS^T01024HELP_TEXT"_$C(30)
  1.  S @DATA@(II)=HDR
  1.  ;
  1.  I VFIEN="" D  G DONE
  1.  . S VFIL=0
  1.  . F  S VFIL=$O(^BQI(90506.3,"D",TYPE,VFIL)) Q:'VFIL  D
  1.  .. ; If it is a subdefinition for a multiple, it is retrieved from the
  1.  .. ; Master definition so don't need to retrieve data fields
  1.  .. I $$GET1^DIQ(90506.3,VFIL_",",.07,"I") Q
  1.  .. D VF(VFIL)
  1.  ;
  1.  ; If someone passes the name
  1.  I VFIEN'?.N S VFIEN=$$FIND1^DIC(90506.3,"","MX",VFILE,"","","ERROR")
  1.  ; If someone passes the file number
  1.  I $L(VFIEN)>6 S VFIEN=$$FIND1^DIC(90506.3,"","MX",VFILE,"","","ERROR")
  1.  ;
  1.  I VFIEN=0 S BMXSEC="Passed in file "_VFILE_" is not correct" Q
  1.  ;
  1.  D VF(VFIEN)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. VF(VFIL) ;EP
  1.  ; Parameters
  1.  ;   VFILN - File Number
  1.  ;   ORD   - Display Order number
  1.  ;   
  1.  NEW VFDATA,VFSDATA,MULTR,SFIL,VFSDATA2,FILTER,VALID,LINK,LRPC,LINP
  1.  NEW BQN,BQP,BQPARM,VFDATA2,PRMND,PNAM,PTYP,PORD
  1.  ;
  1.  S VFDATA=^BQI(90506.3,VFIL,0)
  1.  S VFDATA2=$G(^BQI(90506.3,VFIL,2))
  1.  S FILTER=$S($D(^BQI(90506.3,VFIL,7)):"Y",1:"N")
  1.  S VALID=$P($G(^BQI(90506.3,VFIL,8)),U,1)
  1.  I $P(VFDATA,U,6)="D" Q
  1.  ;
  1.  D PRMS(VFIL)
  1.  ;
  1.  S VFILN=$P(VFDATA,U,2)
  1.  S VALUE=$P(VFDATA,U,1)_U_VFILN_U_$P(VFDATA,U,4)_U_BQPARM(3)_U_$P(VFDATA,U,12)_U_BQPARM(4)_U_$P(VFDATA,U,13)_U_BQPARM(5)_U_$P(VFDATA2,U)_U_BQPARM(6)_U_FILTER_U_VALID
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.3,VFIL,10,"C",ORD)) Q:ORD=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.3,VFIL,10,"C",ORD,IEN)) Q:IEN=""  D
  1.  .. D RET(VFIL,IEN)
  1.  ;
  1.  ;Check for subdefinitions
  1.  S SFIL=""
  1.  F  S SFIL=$O(^BQI(90506.3,"ASUB",VFIL,SFIL)) Q:SFIL=""  D
  1.  . ;S VFILN=$$GET1^DIQ(90506.3,SFIL_",",.02,"E")
  1.  . ;S VALUE=$$GET1^DIQ(90506.3,SFIL_",",.01,"E")_U_VFILN
  1.  . S VFSDATA=^BQI(90506.3,SFIL,0)
  1.  . I $P(VFSDATA,U,3)=1 Q
  1.  . S VFSDATA2=$G(^BQI(90506.3,VFIL,2))
  1.  . S FILTER=$S($D(^BQI(90506.3,VFIL,7)):"Y",1:"N")
  1.  . S VALID=$P($G(^BQI(90506.3,VFIL,8)),U,1)
  1.  . S VFILN=$P(VFSDATA,U,2)
  1.  . D PRMS(SFIL)
  1.  . ;S VALUE=$P(VFSDATA,U,1)_U_VFILN_U_$P(VFSDATA,U,4)_U_$P(VFSDATA,U,12)_U_$P(VFSDATA,U,13)
  1.  . S VALUE=$P(VFSDATA,U,1)_U_VFILN_U_$P(VFSDATA,U,4)_U_BQPARM(3)_U_$P(VFSDATA,U,12)_U_BQPARM(4)_U_$P(VFSDATA,U,13)_U_BQPARM(5)_U_$P(VFSDATA2,U)_U_BQPARM(6)_U_FILTER_U_VALID
  1.  . S ORD=""
  1.  . F  S ORD=$O(^BQI(90506.3,SFIL,10,"C",ORD)) Q:ORD=""  D
  1.  .. S IEN=""
  1.  .. F  S IEN=$O(^BQI(90506.3,SFIL,10,"C",ORD,IEN)) Q:IEN=""  D RET(SFIL,IEN)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RET(VFIL,IEN) ; Retrieve data
  1.  S VDATA=^BQI(90506.3,VFIL,10,IEN,0)
  1.  I $P(VDATA,U,11)=1 Q
  1.  S VDATA1=$G(^BQI(90506.3,VFIL,10,IEN,1))
  1.  S VDATA2=$G(^BQI(90506.3,VFIL,10,IEN,2))
  1.  S VDATA3=$G(^BQI(90506.3,VFIL,10,IEN,3))
  1.  S VDATA9=$G(^BQI(90506.3,VFIL,10,IEN,9))
  1.  NEW DA,IENS
  1.  S DA(1)=VFIL,DA=IEN,IENS=$$IENS^DILF(.DA)
  1.  S MULTR=$$GET1^DIQ(90506.31,IENS,1.08,"E")
  1.  ;
  1.  ; Check for batch editable flag in 90506.1
  1.  NEW CODE,LIEN,BATCH,LINK,LRPC,LINP
  1.  S CODE=$P(VDATA,U,7),BATCH="NO",LINK=$P(VDATA1,U,10)
  1.  S LRPC=$P(VDATA9,U,1),LINP=$P(VDATA9,U,2)
  1.  S LIEN=$O(^BQI(90506.1,"B",CODE,""))
  1.  I LIEN'="" D
  1.  . S BATCH=+$$GET1^DIQ(90506.1,LIEN_",",.17,"I")
  1.  . S BATCH=$S(BATCH=1:"YES",1:"NO")
  1.  ;
  1.  ;Check default field for API - $P(VDATA1,U,4)
  1.  S DEF=$P(VDATA1,U,4)
  1.  I DEF["$$" D
  1.  . NEW DVAL
  1.  . I DEF["~" S DEF=$TR(DEF,"~","^")
  1.  . X DEF
  1.  . S $P(VDATA1,U,4)=DVAL
  1.  ;
  1.  ; Check for patch requirement
  1.  NEW PATCH,CHNG
  1.  S PATCH=$P(VDATA2,U,10),CHNG=$P(VDATA2,U,11)
  1.  I PATCH'="" D
  1.  . I '$$PATCH^XPDUTL(PATCH) Q
  1.  . I CHNG["~" S CHNG=$TR(CHNG,"~","^")
  1.  . X CHNG
  1.  ; Set the clear fields
  1.  S CLEAR="",CN=0,CLRFLD=""
  1.  F  S CN=$O(^BQI(90506.3,VFIL,10,IEN,10,CN)) Q:'CN  D
  1.  . S CLEAR=CLEAR_$P(^BQI(90506.3,VFIL,10,IEN,10,CN,0),"^",1)_";"
  1.  . S CLRFLD=$$TKO^BQIUL1(CLEAR,";")
  1.  ;
  1.  ; Set up the data fields
  1.  S II=II+1,@DATA@(II)=VALUE_U_$P(VDATA,U,1,4)_U_$P(VDATA,U,12)_U_$P(VDATA,U,7)_U_$P(VDATA,U,14)_U
  1.  F BJ=1:1:7,9 S @DATA@(II)=@DATA@(II)_$P(VDATA1,U,BJ)_U
  1.  S @DATA@(II)=@DATA@(II)_BATCH_U
  1.  F BJ=1:1:5 S @DATA@(II)=@DATA@(II)_$P(VDATA2,U,BJ)_U
  1.  S @DATA@(II)=@DATA@(II)_$G(^BQI(90506.3,VFIL,10,IEN,6))_U_$P(VDATA,U,8)_U
  1.  S @DATA@(II)=@DATA@(II)_$P(VDATA,U,9)_U_$P(VDATA,U,10)_U_$P(VDATA2,U,6)_U_$P(VDATA2,U,9)_U
  1.  S @DATA@(II)=@DATA@(II)_$P(VDATA2,U,7)_U_$P(VDATA2,U,8)_U_MULTR_U_$P(VDATA3,U,4)_U
  1.  S @DATA@(II)=@DATA@(II)_$P(VDATA3,U,5)_U_LINK_U_LRPC_U_LINP_U_CLRFLD_U
  1.  ;
  1.  ;Check for HELP text
  1.  K BQIHELPW,BQIHELP
  1.  S VFLD=$P(VDATA3,U,1),VHELP=""
  1.  I VFLD'="" D
  1.  . D FIELD^DID(VFILN,VFLD,"","HELP-PROMPT","BQIHELP")
  1.  . S VHELP=$G(BQIHELP("HELP-PROMPT"))
  1.  . I VHELP="" D
  1.  .. D FIELD^DID(VFILN,VFLD,"Z","DESCRIPTION","BQIHELPW")
  1.  .. I $G(BQIHELPW("DESCRIPTION"))="" Q
  1.  .. S BN=0,VHELP=""
  1.  .. F  S BN=$O(BQIHELPW("DESCRIPTION",BN)) Q:BN=""  D
  1.  ... S VHELP=VHELP_BQIHELPW("DESCRIPTION",BN,0)_$C(10)
  1.  I $P(VDATA3,U,6)'="" S VHELP=$P(VDATA3,U,6)
  1.  S @DATA@(II)=@DATA@(II)_VHELP_$C(30)
  1.  Q
  1.  ;
  1. VST() ;EP - Get default visit type
  1.  NEW VAL
  1.  I $G(DUZ(2))="" Q "IHS"
  1.  ;S VAL=$$GET1^DIQ(9001001.2,DUZ(2)_",",.17,"E")
  1.  S VAL=$$GET1^DIQ(9001001.2,DUZ(2)_",",.17,"I")
  1.  S VAL=$$STC^BQIUL2(9000010,.03,VAL)
  1.  I VAL="" Q "IHS"
  1.  Q VAL
  1.  ;
  1. HSD() ; EP - Get Health Summary Default
  1.  NEW VAL,AVAL
  1.  S AVAL=$$FIND1^DIC(9001015,,"X","ADULT REGULAR")
  1.  I $G(DUZ(2))="" Q AVAL
  1.  S VAL=$$GET1^DIQ(9001000,DUZ(2)_",",.03,"I")
  1.  I VAL="" Q AVAL
  1.  Q VAL
  1.  ;
  1. PWHD() ; EP - Get Patient Wellness Handout Default
  1.  NEW VAL,AVAL
  1.  I $$VERSION^XPDUTL("BJPC")<2.0 Q ""
  1.  S AVAL=$$FIND1^DIC(9001026,,"X","ADULT REGULAR")
  1.  I $G(DUZ(2))="" Q AVAL
  1.  S VAL=$$GET1^DIQ(9001000,DUZ(2)_",",.16,"I")
  1.  I VAL="" Q AVAL
  1.  Q VAL
  1.  ;
  1. NMBR(PBLIEN) ; EP - Get default problem notes number
  1.  ; Input
  1.  ;   PBLIEN - Problem IEN
  1.  ;   Assumes DUZ(2) for the facility
  1.  NEW FACN
  1.  I PBLIEN="" Q 1
  1.  S FACN=$O(^AUPNPROB(PBLIEN,11,"B",DUZ(2),""))
  1.  I FACN="" Q 1
  1.  Q $O(^AUPNPROB(PBLIEN,11,FACN,11,"B",""),-1)+1
  1.  ;
  1. HPRV(BKMDFN) ; EP - Get the default HIV Provider
  1.  NEW VAL,BKMIEN,BKMHIV,BKMIENS,ARRAY
  1.  S BKMHIV=$$HIVIEN^BKMIXX3()
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
  1.  S BKMIENS=BKMHIV_","_BKMIEN_","
  1.  S VAL=""
  1.  I BKMIEN="" D
  1.  . D ALLDP^BDPAPI(BKMDFN,"HIV PROVIDER",.ARRAY)
  1.  . I ARRAY="" S VAL="" Q
  1.  . S VAL=$P(ARRAY,U,2)
  1.  ;
  1.  I BKMIEN'="" D
  1.  . S VAL=$$GET1^DIQ(90451.01,BKMIENS,6,"I")
  1.  Q VAL
  1.  ;
  1. HCSM(BKMDFN) ; EP - Get the default HIV Case Manager
  1.  NEW VAL,BKMIEN,BKMHIV,BKMIENS,ARRAY
  1.  S BKMHIV=$$HIVIEN^BKMIXX3()
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
  1.  S BKMIENS=BKMHIV_","_BKMIEN_","
  1.  S VAL=""
  1.  I BKMIEN="" D
  1.  . D ALLDP^BDPAPI(BKMDFN,"HIV CASE MANAGER",.ARRAY)
  1.  . I ARRAY="" S VAL="" Q
  1.  . S VAL=$P(ARRAY,U,2)
  1.  ;
  1.  I BKMIEN'="" D
  1.  . S VAL=$$GET1^DIQ(90451.01,BKMIENS,6.5,"I")
  1.  Q VAL
  1.  ;
  1. USR() ;EP - Get the default user
  1.  Q DUZ_$C(28)_$P($G(^VA(200,DUZ,0)),U,1)
  1.  ;
  1. STAT() ;EP = Get the CMET status
  1.  Q "T"_$C(28)_"TRACKED"
  1.  ;
  1. TBL(FILE,VALUE) ; EP - Get a default for a specific table value
  1.  NEW IEN
  1.  S IEN=$$FIND1^DIC(FILE,"","MX",VALUE,"","","ERROR")
  1.  Q IEN_$C(28)_VALUE
  1.  ;
  1. CLNCR() ; EP - Get the default for Chart Review
  1.  NEW IEN
  1.  S IEN=$$FIND1^DIC(40.7,"","MX","CHART REV/REC MOD","","","ERROR")
  1.  Q $$GET1^DIQ(40.7,IEN_",",1,"E")_$C(28)_"CHART REV/REC MOD"
  1.  ;
  1. PRMS(VFIL) ;EP - Pull RPC parameters
  1.  F BQN=3:1:6 D
  1.  .S BQPARM(BQN)=""
  1.  .N IDT,PRM,TIDT,TPRM
  1.  .S BQP=0 F  S BQP=$O(^BQI(90506.3,VFIL,BQN,BQP)) Q:'BQP  D
  1.  ..S PRMND=$G(^BQI(90506.3,VFIL,BQN,BQP,0))
  1.  ..S PNAM=$P(PRMND,U)
  1.  ..S PTYP=$P(PRMND,U,2) S:PTYP="" PTYP=$S(PNAM["=":"P",1:"I")
  1.  ..S PORD=$P(PRMND,U,3) S:PORD="" PORD=BQP_PNAM
  1.  ..;
  1.  ..;Temp Store of Unique Identifiers
  1.  ..I PTYP="I" D
  1.  ...S TIDT(PORD)=PRMND
  1.  ..;
  1.  ..;Temp Store of Regular Parameters
  1.  ..I PTYP="P" D
  1.  ...S TPRM(PORD)=PRMND
  1.  .;
  1.  .;Form Parameter String
  1.  .S IDT="",BQP="" F  S BQP=$O(TIDT(BQP)) Q:BQP=""  S IDT=IDT_$S(IDT]"":";",1:"")_$P(TIDT(BQP),U)
  1.  .S PRM="",BQP="" F  S BQP=$O(TPRM(BQP)) Q:BQP=""  S PRM=PRM_$S(PRM]"":$C(28),1:"")_$P(TPRM(BQP),U)
  1.  .S BQPARM(BQN)=IDT_$S(IDT]"":";",1:"")_PRM
  1.  .S BQPARM(BQN)=$$TKO^BQIUL1(BQPARM(BQN),";")
  1.  Q
  1.  ;
  1. EVT(EVIEN,POS) ;EP - Event Default
  1.  NEW EVTYPE,EVVALUE,IVALIEN,EIEN,TY
  1.  S EVTYPE="",EVVALUE="",IVALIEN="",EIEN=""
  1.  I $G(EVIEN)="" Q ""
  1.  S TY=$$GET1^DIQ(90621,EVIEN_",",.12,"I")
  1.  I TY'="" S EVTYPE=$$GET1^DIQ(90621.1,TY_",",.09,"E")
  1.  I TY'="" S EIEN=$O(^BTPW(90621,EVIEN,1,"C",TY,""))
  1.  I $G(EIEN)'="" D
  1.  . S EVVALUE=$P(^BTPW(90621,EVIEN,1,EIEN,0),"^",5),IVALIEN=$P(^(0),"^",6),TAXIEN=$P(^(0),U,2)
  1.  I POS=1 Q $G(EVTYPE)
  1.  I POS=2 Q $G(EVVALUE)
  1.  I POS=3 Q $G(IVALIEN)
  1.  I POS=4 Q $G(TAXIEN)