BQIRGHLP ;PRXM/HC/ALA-Register Help ; 08 Nov 2007 2:04 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
EN(DATA,REG,CODE) ;EP -- BQI GET REGISTER HELP TEXT
; Input
; REG - A Register NAME
; CODE - A field CODE if wanting the help text for a specific register field
; otherwise if it is null, then retrieves the help text for all register fields
;
NEW UID,II,RGIEN,RIEN,SIEN,TYPE,ORD,IEN,BQIHELP,AVHELP
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIRGHLP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGHLP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S REG=$G(REG,""),CODE=$G(CODE,"")
;
S @DATA@(II)="T00050REG_NAME^T00015CODE^T01024REPORT_TEXT"_$C(30)
;
I $G(REG)'="" D Q:$G(BMXSEC)'=""
. S RGIEN=$O(^BQI(90506.3,"B",REG,""))
. I RGIEN="" S BMXSEC="No Register found" Q
. D GREG(RGIEN)
. ;
. I CODE'="" D
.. S RIEN=$O(^BQI(90506.1,"B",CODE,""))
.. D GETDATA(RIEN)
;
I $G(REG)="" D
. S RGIEN=0
. F S RGIEN=$O(^BQI(90506.3,RGIEN)) Q:'RGIEN D
.. I $P(^BQI(90506.3,RGIEN,0),U,3)=1 Q
.. I $P(^BQI(90506.3,RGIEN,0),U,6)'="R" Q
.. I $P(^BQI(90506.3,RGIEN,0),U,7)=1 Q
.. S REG=$P(^BQI(90506.3,RGIEN,0),U,1)
.. D GREG(RGIEN)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
;
GREG(RGIEN) ;
S ORD=""
F S ORD=$O(^BQI(90506.3,RGIEN,10,"C",ORD)) Q:ORD="" D
. S IEN=""
. F S IEN=$O(^BQI(90506.3,RGIEN,10,"C",ORD,IEN)) Q:IEN="" D
.. I $P(^BQI(90506.3,RGIEN,10,IEN,0),U,4)'="S" Q
.. S CODE=$P(^BQI(90506.3,RGIEN,10,IEN,0),U,7) I CODE="" Q
.. S TYPE=$P($G(^BQI(90506.3,RGIEN,10,IEN,1)),U,1)
.. S AVHELP=$P($G(^BQI(90506.3,RGIEN,10,IEN,3)),U,6)
.. ; If this is a multiple, go to the subdefinition
.. I TYPE="M" D Q
... NEW SNAME,SRIEN,SORD
... S SNAME=$P(^BQI(90506.3,RGIEN,10,IEN,0),U,1)
... S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q
... S SORD=""
... F S SORD=$O(^BQI(90506.3,SRIEN,10,"C",SORD)) Q:SORD="" D
.... S SIEN=""
.... F S SIEN=$O(^BQI(90506.3,SRIEN,10,"C",SORD,SIEN)) Q:SIEN="" D
..... I $P(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S" Q
..... S CODE=$P(^BQI(90506.3,SRIEN,10,SIEN,0),U,7) I CODE="" Q
..... S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
..... S AVHELP=$P($G(^BQI(90506.3,SRIEN,10,SIEN,3)),U,6)
..... NEW REG
..... S REG=SNAME
..... D GETDATA(RIEN)
.. I CODE="" Q
.. S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
.. ;
.. D GETDATA(RIEN)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
GETDATA(RIEN) ;EP - Get the reminder help text
NEW VHELP,FILE,FIELD,NAME,BQIHELPW,BN,VN
I $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1 Q
S NAME=$P(^BQI(90506.1,RIEN,0),U,3)
S VHELP="",VN=0
F S VN=$O(^BQI(90506.1,RIEN,4,VN)) Q:'VN D
. S VHELP=VHELP_^BQI(90506.1,RIEN,4,VN,0)_$C(10)
;S FILE=$P(^BQI(90506.1,RIEN,0),U,5)
;S FIELD=$P(^BQI(90506.1,RIEN,0),U,6)
;D FIELD^DID(FILE,FIELD,"","HELP-PROMPT","BQIHELP")
;S VHELP=$G(BQIHELP("HELP-PROMPT"))
;I VHELP="" D
;. D FIELD^DID(FILE,FIELD,"Z","DESCRIPTION","BQIHELPW")
;. I $G(BQIHELPW("DESCRIPTION"))="" Q
;. S BN=0,VHELP=""
;. F S BN=$O(BQIHELPW("DESCRIPTION",BN)) Q:BN="" D
;.. S VHELP=VHELP_BQIHELPW("DESCRIPTION",BN,0)_$C(10)
S VHELP=$$TKO^BQIUL1(VHELP,$C(10))
I $G(AVHELP)'="" S VHELP=AVHELP
;
S II=II+1,@DATA@(II)=REG_U_CODE_U_VHELP_$C(30)
S CODE=""
Q
BQIRGHLP ;PRXM/HC/ALA-Register Help ; 08 Nov 2007 2:04 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
EN(DATA,REG,CODE) ;EP -- BQI GET REGISTER HELP TEXT
+1 ; Input
+2 ; REG - A Register NAME
+3 ; CODE - A field CODE if wanting the help text for a specific register field
+4 ; otherwise if it is null, then retrieves the help text for all register fields
+5 ;
+6 NEW UID,II,RGIEN,RIEN,SIEN,TYPE,ORD,IEN,BQIHELP,AVHELP
+7 ;
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIRGHLP",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIRGHLP D UNWIND^%ZTER"
+14 ;
+15 SET REG=$GET(REG,"")
SET CODE=$GET(CODE,"")
+16 ;
+17 SET @DATA@(II)="T00050REG_NAME^T00015CODE^T01024REPORT_TEXT"_$CHAR(30)
+18 ;
+19 IF $GET(REG)'=""
Begin DoDot:1
+20 SET RGIEN=$ORDER(^BQI(90506.3,"B",REG,""))
+21 IF RGIEN=""
SET BMXSEC="No Register found"
QUIT
+22 DO GREG(RGIEN)
+23 ;
+24 IF CODE'=""
Begin DoDot:2
+25 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
+26 DO GETDATA(RIEN)
End DoDot:2
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+27 ;
+28 IF $GET(REG)=""
Begin DoDot:1
+29 SET RGIEN=0
+30 FOR
SET RGIEN=$ORDER(^BQI(90506.3,RGIEN))
IF 'RGIEN
QUIT
Begin DoDot:2
+31 IF $PIECE(^BQI(90506.3,RGIEN,0),U,3)=1
QUIT
+32 IF $PIECE(^BQI(90506.3,RGIEN,0),U,6)'="R"
QUIT
+33 IF $PIECE(^BQI(90506.3,RGIEN,0),U,7)=1
QUIT
+34 SET REG=$PIECE(^BQI(90506.3,RGIEN,0),U,1)
+35 DO GREG(RGIEN)
End DoDot:2
End DoDot:1
+36 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
+4 ;
GREG(RGIEN) ;
+1 SET ORD=""
+2 FOR
SET ORD=$ORDER(^BQI(90506.3,RGIEN,10,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+3 SET IEN=""
+4 FOR
SET IEN=$ORDER(^BQI(90506.3,RGIEN,10,"C",ORD,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+5 IF $PIECE(^BQI(90506.3,RGIEN,10,IEN,0),U,4)'="S"
QUIT
+6 SET CODE=$PIECE(^BQI(90506.3,RGIEN,10,IEN,0),U,7)
IF CODE=""
QUIT
+7 SET TYPE=$PIECE($GET(^BQI(90506.3,RGIEN,10,IEN,1)),U,1)
+8 SET AVHELP=$PIECE($GET(^BQI(90506.3,RGIEN,10,IEN,3)),U,6)
+9 ; If this is a multiple, go to the subdefinition
+10 IF TYPE="M"
Begin DoDot:3
+11 NEW SNAME,SRIEN,SORD
+12 SET SNAME=$PIECE(^BQI(90506.3,RGIEN,10,IEN,0),U,1)
+13 SET SRIEN=$ORDER(^BQI(90506.3,"B",SNAME,""))
IF SRIEN=""
QUIT
+14 SET SORD=""
+15 FOR
SET SORD=$ORDER(^BQI(90506.3,SRIEN,10,"C",SORD))
IF SORD=""
QUIT
Begin DoDot:4
+16 SET SIEN=""
+17 FOR
SET SIEN=$ORDER(^BQI(90506.3,SRIEN,10,"C",SORD,SIEN))
IF SIEN=""
QUIT
Begin DoDot:5
+18 IF $PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S"
QUIT
+19 SET CODE=$PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,7)
IF CODE=""
QUIT
+20 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+21 SET AVHELP=$PIECE($GET(^BQI(90506.3,SRIEN,10,SIEN,3)),U,6)
+22 NEW REG
+23 SET REG=SNAME
+24 DO GETDATA(RIEN)
End DoDot:5
End DoDot:4
End DoDot:3
QUIT
+25 IF CODE=""
QUIT
+26 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+27 ;
+28 DO GETDATA(RIEN)
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
GETDATA(RIEN) ;EP - Get the reminder help text
+1 NEW VHELP,FILE,FIELD,NAME,BQIHELPW,BN,VN
+2 IF $$GET1^DIQ(90506.1,RIEN_",",.1,"I")=1
QUIT
+3 SET NAME=$PIECE(^BQI(90506.1,RIEN,0),U,3)
+4 SET VHELP=""
SET VN=0
+5 FOR
SET VN=$ORDER(^BQI(90506.1,RIEN,4,VN))
IF 'VN
QUIT
Begin DoDot:1
+6 SET VHELP=VHELP_^BQI(90506.1,RIEN,4,VN,0)_$CHAR(10)
End DoDot:1
+7 ;S FILE=$P(^BQI(90506.1,RIEN,0),U,5)
+8 ;S FIELD=$P(^BQI(90506.1,RIEN,0),U,6)
+9 ;D FIELD^DID(FILE,FIELD,"","HELP-PROMPT","BQIHELP")
+10 ;S VHELP=$G(BQIHELP("HELP-PROMPT"))
+11 ;I VHELP="" D
+12 ;. D FIELD^DID(FILE,FIELD,"Z","DESCRIPTION","BQIHELPW")
+13 ;. I $G(BQIHELPW("DESCRIPTION"))="" Q
+14 ;. S BN=0,VHELP=""
+15 ;. F S BN=$O(BQIHELPW("DESCRIPTION",BN)) Q:BN="" D
+16 ;.. S VHELP=VHELP_BQIHELPW("DESCRIPTION",BN,0)_$C(10)
+17 SET VHELP=$$TKO^BQIUL1(VHELP,$CHAR(10))
+18 IF $GET(AVHELP)'=""
SET VHELP=AVHELP
+19 ;
+20 SET II=II+1
SET @DATA@(II)=REG_U_CODE_U_VHELP_$CHAR(30)
+21 SET CODE=""
+22 QUIT
