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

BQIVFCHC.m

Go to the documentation of this file. 
  1. BQIVFCHC ;PRXM/HC/ALA-Return 'Choice' values for the GUI ; 09 Apr 2007  4:33 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
  1.  Q
  1.  ;
  1. EN(DATA,VFILE,CODE) ;EP -- BQI GET VFILE CHOICE
  1.  ;
  1.  ;Input
  1.  ;  VFILE - The vfile number or name
  1.  ;  CODE  - The parameter name
  1.  ;
  1.  NEW UID,II,HDR,IEN,VALUE,HELP,VFIEN,HN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIVFCHC",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S VFILE=$G(VFILE,"") I VFILE="" S BMXSEC="No Vfile selected" Q
  1.  S VFIEN=$$FIND1^DIC(90506.3,"","M",VFILE,"","","ERROR")
  1.  S CODE=$G(CODE,"") I CODE="" S BMXSEC="No code given" Q
  1.  I $O(^BQI(90506.3,VFIEN,10,"AC",CODE,""))="" S BMXSEC="Code does not exist for this Vfile" Q
  1.  NEW DA,IENS
  1.  S DA(2)=VFIEN
  1.  ;
  1.  S HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE^T00001VALIDATION^T00008HELP_ASSOC^T01024CHOICE_HELP"_$C(30)
  1.  S @DATA@(II)=HDR
  1.  ;
  1.  NEW CIEN
  1.  S CIEN=""
  1.  F  S CIEN=$O(^BQI(90506.3,VFIEN,10,"AC",CODE,CIEN)) Q:CIEN=""  D
  1.  . I $P(^BQI(90506.3,VFIEN,10,CIEN,0),U,11)=1 Q
  1.  . S DA(1)=CIEN
  1.  ;
  1.  I $G(DA(1))]"" D
  1.  . I $O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))="" D STD
  1.  . I $O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",""))'="" D NST
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  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. NST ; Sort in designated order
  1.  NEW ORD
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD)) Q:ORD=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,"AC",ORD,IEN)) Q:IEN=""  D REC
  1.  Q
  1.  ;
  1. STD ; Sort in standard order
  1.  S IEN=0
  1.  F  S IEN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,IEN)) Q:'IEN  D REC
  1.  Q
  1.  ;
  1. REC ; Get record values
  1.  I $P(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,0),U,5)=1 Q
  1.  S DA=IEN,IENS=$$IENS^DILF(.DA),VALUE=""
  1.  S VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.01,"E")_U_$$GET1^DIQ(90506.315,IENS,.02,"E")_U_$$GET1^DIQ(90506.315,IENS,.03,"I")_U
  1.  S VALUE=VALUE_$$GET1^DIQ(90506.315,IENS,.04,"E")_U
  1.  S HN=0,HELP=""
  1.  F  S HN=$O(^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN)) Q:'HN  D
  1.  . S HELP=HELP_^BQI(90506.3,VFIEN,10,DA(1),5,IEN,1,HN,0)_$C(10)
  1.  S HELP=$$TKO^BQIUL1(HELP,$C(10))
  1.  S VALUE=VALUE_HELP_$C(30)
  1.  S II=II+1,@DATA@(II)=VALUE
  1.  Q
  1.  ;
  1. CMET(DATA,FAKE) ;EP -- BQI GET CMET CHOICE
  1.  NEW UID,II,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQICMETCH",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S HDR="T00020CHOICE_TEXT^T00005CHOICE_CODE"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S TEXT=$P(^DD(90505,.09,0),U,3)
  1.  F BQ=1:1:$L(TEXT,";") S VAL=$P(TEXT,";",BQ) Q:VAL=""  D
  1.  . S II=II+1,@DATA@(II)=$P(VAL,":",2)_U_$P(VAL,":",1)_$C(30)
  1.  G DONE
  1.  ;
  1. MU(DATA,FAKE) ;EP -- BQI GET MU CHOICE
  1.  NEW UID,II,HDR,TEXT,BQ,VAL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUCH",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIVFCHC D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S HDR="T00005CHOICE_CODE^T00020CHOICE_TEXT^T00001CHOICE_TAB"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S BQ=0
  1.  F  S BQ=$O(^BQI(90506.71,BQ)) Q:'BQ  D
  1.  . ;S TEXT=$P(^BQI(90506.71,BQ,0),U,2)
  1.  . S II=II+1,@DATA@(II)=^BQI(90506.71,BQ,0)_$C(30)
  1.  G DONE