- 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
