- BQIRGASP ;VNGT/HS/ALA-Asthma Patient ; 06 Mar 2009 3:58 PM
- ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
- ;
- ;
- EN(DATA,DFN,SOURCE) ;EP - BQI REFRESH PATIENT CARE MGT
- ; Input
- ; DFN - Patient internal entry number
- ; SOURCE - The Care Managment Source Type (full name e.g. Asthma)
- ;
- NEW UID,II,BQDFN,SRCN,SRC,RESULT
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP(UID,"BQIRGASP"))
- K @DATA
- ;
- S II=0
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMPAT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- S @DATA@(II)="I00010RESULT^T00050MSG"_$C(30)
- S BQDFN=$G(DFN,""),SOURCE=$G(SOURCE,"")
- I BQDFN="" S RESULT=-1_U_"No patient selected" G DONE
- ;
- I SOURCE'="" D G DONE
- . S SRCN=$O(^BQI(90506.5,"B",SOURCE,"")) I SRCN="" S RESULT=-1_U_SOURCE_" not found" Q
- . S SRC=$P(^BQI(90506.5,SRCN,0),U,2)
- . D PAT(BQDFN,SRC)
- . S RESULT=1_U
- ;
- I SOURCE="" D G DONE
- . K ^BQIPAT(DFN,60)
- . ; If flag is set for nightly/weekly
- . S SRIEN=""
- . F S SRIEN=$O(^BQI(90506.5,"AD",1,SRIEN)) Q:SRIEN="" D
- .. I $P($G(^BQI(90506.5,SRIEN,0)),"^",10)=1 Q
- .. ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
- .. S SOURCE=$P($G(^BQI(90506.5,SRIEN,0)),"^",1)
- .. S SRC=$P($G(^BQI(90506.5,SRIEN,0)),U,2)
- .. D PAT(BQDFN,SRC)
- .. S RESULT=1_U
- ;
- DONE ;
- S II=II+1,@DATA@(II)=RESULT_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- PAT(BQDFN,SRC) ;EP - Get all Care Mgmt data for a patient
- ;
- NEW DA,IENS,DIC,PSRIEN,SRIEN,CDRIEN,X,Y,CODE,DLAYGO,DIC,HDR,IEN,ORD,V
- NEW BQIUPD,VALUE,VISIT,OTHER,STVW,VAL,VSDTM,CT,ASN,%ANS,APCHSBWR,R,T,W
- NEW APCHSDAT,APCHSTEX,APCHSTXN,LPAP,%1,%ANS,%DT,%X,%Y,AIEN,AMQQTAXN,LT,M
- NEW APCHC,APCHCPT,APCHLAST,APCHRF,BD,C,D,D0,DAT1,DAT2,DATE,E,ED,G,H,J
- S SRIEN=$O(^BQI(90506.5,"C",SRC,"")) I SRIEN="" Q
- ; Check for bad records
- I $O(^BQIPAT(BQDFN,60,"B",SRIEN,""))="" D
- . S ASN=0
- . F S ASN=$O(^BQIPAT(BQDFN,60,ASN)) Q:'ASN D
- .. I $G(^BQIPAT(BQDFN,60,ASN,0))'="",$P($G(^BQIPAT(BQDFN,60,ASN,0)),U,1)'=SRIEN Q
- .. I $G(^BQIPAT(BQDFN,60,ASN,0))'="",$P($G(^BQIPAT(BQDFN,60,ASN,0)),U,1)=SRIEN Q
- .. K ^BQIPAT(BQDFN,60,ASN)
- ;
- S DA(1)=BQDFN,X=$P(^BQI(90506.5,SRIEN,0),U,1),DIC(0)="L",DLAYGO=90507.56
- S DIC="^BQIPAT("_DA(1)_",60,"
- I $G(^BQIPAT(BQDFN,60,0))="" S ^BQIPAT(BQDFN,60,0)="^90507.56P^^"
- D ^DIC
- S (PSRIEN,DA)=+Y
- S IENS=$$IENS^DILF(.DA)
- S BQIUPD(90507.56,IENS,.02)=$$NOW^XLFDT()
- ;
- I $G(SRC)="DM" D
- . S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BDMJOB=UID,BDMBTH=$H
- . S CYR=$P($G(^BQI(90508,1,"DM")),U,1),BDMDMRG=$P($G(^BQI(90508,1,"DM")),"^",2)
- . S CIEN=$O(^BQI(90508,1,21,"B",CYR,"")) I CIEN="" Q
- . S PGTHR=$P(^BQI(90508,1,21,CIEN,0),U,2),PGRF=$P(^(0),U,4)
- . K ^XTMP(PGRF,BDMJOB) S ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"
- . S BDMRBD=DT,BDMADAT=DT,BDMTYPE="P",BDMRED=$$FMADD^XLFDT(BDMADAT,-365)
- . S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365),BDMPD=DFN
- . D @("GATHER^"_PGTHR)
- ;
- ; Check for Alternate display order first
- S ORD=""
- F S ORD=$O(^BQI(90506.1,"AF",SRC,ORD)) Q:ORD="" D
- . S AIEN=""
- . F S AIEN=$O(^BQI(90506.1,"AF",SRC,ORD,AIEN)) Q:AIEN="" D UPD(AIEN)
- ;
- ; Check for normal display order
- S ORD=""
- F S ORD=$O(^BQI(90506.1,"AD",SRC,ORD)) Q:ORD="" D
- . S AIEN=""
- . F S AIEN=$O(^BQI(90506.1,"AD",SRC,ORD,AIEN)) Q:AIEN="" D UPD(AIEN)
- ;
- ; Check for site-populated fields
- S AIEN=0 F S AIEN=$O(^BQI(90506.5,SRIEN,10,AIEN)) Q:'AIEN D
- . S EXEC=$G(^BQI(90506.5,SRIEN,10,AIEN,3)) I EXEC="" Q
- . X EXEC
- . S CODE=$P(^BQI(90506.5,SRIEN,10,AIEN,0),"^",1)
- . D FILD
- Q
- ;
- UPD(AIEN) ; EP - Update values
- ;I $$GET1^DIQ(90506.1,AIEN_",",.1,"I")=1 Q
- I $P($G(^BQI(90506.1,AIEN,0)),"^",10)=1 Q
- S STVW=AIEN,VAL="",VISIT="",OTHER=""
- D CVAL(BQDFN)
- S CODE=$P($G(^BQI(90506.1,AIEN,0)),U,1) I CODE="" Q
- I VAL'="" D
- . I CODE="DM_TOBUSE" S VAL=$P(VAL,U,2)
- . I CODE="DM_A1C" S VAL=$P(VAL,U,2)_" ("_$$FMTMDY^BQIUL1($P(VAL,U,1))_")"
- . I CODE="DM_CREAT"!(CODE="DM_TCHOL")!(CODE="DM_HDL")!(CODE="DM_LDL")!(CODE="DM_TRIG") S VAL=$P(VAL,U,1)_"("_$P(VAL,U,2)_")"
- . I CODE="DM_EGFR"!(CODE="DM_UACR") S VAL=$P(VAL,U,2)_" ("_$P(VAL,U,3)_")"
- . I CODE="DM_TBTEST" S VAL=$P(VAL,"|",1)
- . I CODE="DM_TBRES" S VAL=$P(VAL,"|",3)
- ;
- I VAL="",CODE="DM_DMTYP" D
- . D CURR
- . D @("TYPEDM^"_PGTHR) I BDMTYDM'="" S VAL=BDMTYDM
- D FILD
- Q
- ;
- FILD ;EP - File the data
- S DA(2)=BQDFN,DA(1)=PSRIEN,X=CODE,DIC(0)="L",DLAYGO=90507.561
- S DIC="^BQIPAT("_DA(2)_",60,"_DA(1)_",1,"
- I $G(^BQIPAT(BQDFN,60,PSRIEN,1,0))="" S ^BQIPAT(BQDFN,60,PSRIEN,1,0)="^90507.561^^"
- D ^DIC I +Y=-1 K DD,DO D FILE^DICN
- S (CDRIEN,DA)=+Y
- S IENS=$$IENS^DILF(.DA)
- S BQIUPD(90507.561,IENS,.02)=$G(VAL)
- S BQIUPD(90507.561,IENS,.03)=$G(DATE)
- S BQIUPD(90507.561,IENS,.04)=$G(VISIT)
- S BQIUPD(90507.561,IENS,.05)=$G(OTHER)
- K VAL,OTHER,DATE,VISIT
- I $D(BQIUPD)>0 D FILE^DIE("","BQIUPD","ERROR")
- Q
- ;
- CVAL(DFN) ; Get demographic values
- ;Parameters
- ; FIL = FileMan file number
- ; FLD = FileMan field number
- ; EXEC = If an executable is needed to determine value
- ; HDR = Header value
- ;the executable expects the value to be returned in variable VAL
- NEW FIL,FLD,EXEC,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE
- S FIL=$P($G(^BQI(90506.1,STVW,0)),"^",5)
- S FLD=$P($G(^BQI(90506.1,STVW,0)),"^",6)
- S EXEC=$G(^BQI(90506.1,STVW,5))
- S HDR=$P($G(^BQI(90506.1,STVW,0)),"^",8)
- I $G(DFN)="" S VAL="" Q
- ;
- I $G(EXEC)'="" X EXEC Q
- ;
- I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
- Q
- ;
- S RCODE=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
- S RGIEN=$O(^BQI(90506.3,"AC",CRIEN,"")),VAL=""
- I RGIEN'="" D Q:VAL'=""
- . S RIEN=$O(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))
- . I RIEN'="",$P($G(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M" D Q
- .. S RHDR=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,2),MVALUE=""
- .. NEW SNAME,SRIEN,SORD,SXREF,SIEN
- .. S SNAME=$P(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)
- .. S SRIEN=$O(^BQI(90506.3,"B",SNAME,"")) I SRIEN="" Q
- .. S SORD="",SXREF=$S($D(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")
- .. F S SORD=$O(^BQI(90506.3,SRIEN,10,SXREF,SORD)) Q:SORD="" D
- ... S SIEN=""
- ... F S SIEN=$O(^BQI(90506.3,SRIEN,10,SXREF,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 STVW=$O(^BQI(90506.1,"B",CODE,"")) I STVW="" Q
- .... I $P($G(^BQI(90506.1,STVW,0)),"^",10)=1 Q
- .... NEW FIL,FLD,EXEC
- .... S FIL=$P($G(^BQI(90506.1,STVW,0)),"^",5)
- .... S FLD=$P($G(^BQI(90506.1,STVW,0)),"^",6)
- .... S EXEC=$G(^BQI(90506.1,STVW,1))
- .... S HDR=RHDR
- .... I $G(DFN)="" S VAL="" Q
- .... ;
- .... I $G(EXEC)'="" X EXEC S VAL=VAL_$S(VAL'="":$C(10),1:"") Q
- .... I FIL'="",FLD'="" S VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
- .... S VALUE=VALUE_VAL_$S(VAL'="":$C(10),1:"")
- .... S VAL=VALUE
- ... S MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$C(10))
- .. S VAL=MVALUE
- Q
- ;
- CURR ;EP - Get current DM Audit information
- S CYR=$P($G(^BQI(90508,1,"DM")),U,1)
- S CIEN=$O(^BQI(90508,1,21,"B",CYR,"")) I CIEN="" Q
- S PGTHR=$P(^BQI(90508,1,21,CIEN,0),U,2),PGRF=$P(^(0),U,4)
- Q
- BQIRGASP ;VNGT/HS/ALA-Asthma Patient ; 06 Mar 2009 3:58 PM
- +1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
- +2 ;
- +3 ;
- EN(DATA,DFN,SOURCE) ;EP - BQI REFRESH PATIENT CARE MGT
- +1 ; Input
- +2 ; DFN - Patient internal entry number
- +3 ; SOURCE - The Care Managment Source Type (full name e.g. Asthma)
- +4 ;
- +5 NEW UID,II,BQDFN,SRCN,SRC,RESULT
- +6 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +7 SET DATA=$NAME(^TMP(UID,"BQIRGASP"))
- +8 KILL @DATA
- +9 ;
- +10 SET II=0
- +11 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIRMPAT D UNWIND^%ZTER"
- +12 SET @DATA@(II)="I00010RESULT^T00050MSG"_$CHAR(30)
- +13 SET BQDFN=$GET(DFN,"")
- SET SOURCE=$GET(SOURCE,"")
- +14 IF BQDFN=""
- SET RESULT=-1_U_"No patient selected"
- GOTO DONE
- +15 ;
- +16 IF SOURCE'=""
- Begin DoDot:1
- +17 SET SRCN=$ORDER(^BQI(90506.5,"B",SOURCE,""))
- IF SRCN=""
- SET RESULT=-1_U_SOURCE_" not found"
- QUIT
- +18 SET SRC=$PIECE(^BQI(90506.5,SRCN,0),U,2)
- +19 DO PAT(BQDFN,SRC)
- +20 SET RESULT=1_U
- End DoDot:1
- GOTO DONE
- +21 ;
- +22 IF SOURCE=""
- Begin DoDot:1
- +23 KILL ^BQIPAT(DFN,60)
- +24 ; If flag is set for nightly/weekly
- +25 SET SRIEN=""
- +26 FOR
- SET SRIEN=$ORDER(^BQI(90506.5,"AD",1,SRIEN))
- IF SRIEN=""
- QUIT
- Begin DoDot:2
- +27 IF $PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",10)=1
- QUIT
- +28 ;I $P($G(^BQI(90506.5,SRIEN,0)),"^",16)'=1 Q
- +29 SET SOURCE=$PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",1)
- +30 SET SRC=$PIECE($GET(^BQI(90506.5,SRIEN,0)),U,2)
- +31 DO PAT(BQDFN,SRC)
- +32 SET RESULT=1_U
- End DoDot:2
- End DoDot:1
- GOTO DONE
- +33 ;
- DONE ;
- +1 SET II=II+1
- SET @DATA@(II)=RESULT_$CHAR(30)
- +2 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +3 QUIT
- +4 ;
- PAT(BQDFN,SRC) ;EP - Get all Care Mgmt data for a patient
- +1 ;
- +2 NEW DA,IENS,DIC,PSRIEN,SRIEN,CDRIEN,X,Y,CODE,DLAYGO,DIC,HDR,IEN,ORD,V
- +3 NEW BQIUPD,VALUE,VISIT,OTHER,STVW,VAL,VSDTM,CT,ASN,%ANS,APCHSBWR,R,T,W
- +4 NEW APCHSDAT,APCHSTEX,APCHSTXN,LPAP,%1,%ANS,%DT,%X,%Y,AIEN,AMQQTAXN,LT,M
- +5 NEW APCHC,APCHCPT,APCHLAST,APCHRF,BD,C,D,D0,DAT1,DAT2,DATE,E,ED,G,H,J
- +6 SET SRIEN=$ORDER(^BQI(90506.5,"C",SRC,""))
- IF SRIEN=""
- QUIT
- +7 ; Check for bad records
- +8 IF $ORDER(^BQIPAT(BQDFN,60,"B",SRIEN,""))=""
- Begin DoDot:1
- +9 SET ASN=0
- +10 FOR
- SET ASN=$ORDER(^BQIPAT(BQDFN,60,ASN))
- IF 'ASN
- QUIT
- Begin DoDot:2
- +11 IF $GET(^BQIPAT(BQDFN,60,ASN,0))'=""
- IF $PIECE($GET(^BQIPAT(BQDFN,60,ASN,0)),U,1)'=SRIEN
- QUIT
- +12 IF $GET(^BQIPAT(BQDFN,60,ASN,0))'=""
- IF $PIECE($GET(^BQIPAT(BQDFN,60,ASN,0)),U,1)=SRIEN
- QUIT
- +13 KILL ^BQIPAT(BQDFN,60,ASN)
- End DoDot:2
- End DoDot:1
- +14 ;
- +15 SET DA(1)=BQDFN
- SET X=$PIECE(^BQI(90506.5,SRIEN,0),U,1)
- SET DIC(0)="L"
- SET DLAYGO=90507.56
- +16 SET DIC="^BQIPAT("_DA(1)_",60,"
- +17 IF $GET(^BQIPAT(BQDFN,60,0))=""
- SET ^BQIPAT(BQDFN,60,0)="^90507.56P^^"
- +18 DO ^DIC
- +19 SET (PSRIEN,DA)=+Y
- +20 SET IENS=$$IENS^DILF(.DA)
- +21 SET BQIUPD(90507.56,IENS,.02)=$$NOW^XLFDT()
- +22 ;
- +23 IF $GET(SRC)="DM"
- Begin DoDot:1
- +24 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- SET BDMJOB=UID
- SET BDMBTH=$HOROLOG
- +25 SET CYR=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
- SET BDMDMRG=$PIECE($GET(^BQI(90508,1,"DM")),"^",2)
- +26 SET CIEN=$ORDER(^BQI(90508,1,21,"B",CYR,""))
- IF CIEN=""
- QUIT
- +27 SET PGTHR=$PIECE(^BQI(90508,1,21,CIEN,0),U,2)
- SET PGRF=$PIECE(^(0),U,4)
- +28 KILL ^XTMP(PGRF,BDMJOB)
- SET ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"
- +29 SET BDMRBD=DT
- SET BDMADAT=DT
- SET BDMTYPE="P"
- SET BDMRED=$$FMADD^XLFDT(BDMADAT,-365)
- +30 SET BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)
- SET BDMPD=DFN
- +31 DO @("GATHER^"_PGTHR)
- End DoDot:1
- +32 ;
- +33 ; Check for Alternate display order first
- +34 SET ORD=""
- +35 FOR
- SET ORD=$ORDER(^BQI(90506.1,"AF",SRC,ORD))
- IF ORD=""
- QUIT
- Begin DoDot:1
- +36 SET AIEN=""
- +37 FOR
- SET AIEN=$ORDER(^BQI(90506.1,"AF",SRC,ORD,AIEN))
- IF AIEN=""
- QUIT
- DO UPD(AIEN)
- End DoDot:1
- +38 ;
- +39 ; Check for normal display order
- +40 SET ORD=""
- +41 FOR
- SET ORD=$ORDER(^BQI(90506.1,"AD",SRC,ORD))
- IF ORD=""
- QUIT
- Begin DoDot:1
- +42 SET AIEN=""
- +43 FOR
- SET AIEN=$ORDER(^BQI(90506.1,"AD",SRC,ORD,AIEN))
- IF AIEN=""
- QUIT
- DO UPD(AIEN)
- End DoDot:1
- +44 ;
- +45 ; Check for site-populated fields
- +46 SET AIEN=0
- FOR
- SET AIEN=$ORDER(^BQI(90506.5,SRIEN,10,AIEN))
- IF 'AIEN
- QUIT
- Begin DoDot:1
- +47 SET EXEC=$GET(^BQI(90506.5,SRIEN,10,AIEN,3))
- IF EXEC=""
- QUIT
- +48 XECUTE EXEC
- +49 SET CODE=$PIECE(^BQI(90506.5,SRIEN,10,AIEN,0),"^",1)
- +50 DO FILD
- End DoDot:1
- +51 QUIT
- +52 ;
- UPD(AIEN) ; EP - Update values
- +1 ;I $$GET1^DIQ(90506.1,AIEN_",",.1,"I")=1 Q
- +2 IF $PIECE($GET(^BQI(90506.1,AIEN,0)),"^",10)=1
- QUIT
- +3 SET STVW=AIEN
- SET VAL=""
- SET VISIT=""
- SET OTHER=""
- +4 DO CVAL(BQDFN)
- +5 SET CODE=$PIECE($GET(^BQI(90506.1,AIEN,0)),U,1)
- IF CODE=""
- QUIT
- +6 IF VAL'=""
- Begin DoDot:1
- +7 IF CODE="DM_TOBUSE"
- SET VAL=$PIECE(VAL,U,2)
- +8 IF CODE="DM_A1C"
- SET VAL=$PIECE(VAL,U,2)_" ("_$$FMTMDY^BQIUL1($PIECE(VAL,U,1))_")"
- +9 IF CODE="DM_CREAT"!(CODE="DM_TCHOL")!(CODE="DM_HDL")!(CODE="DM_LDL")!(CODE="DM_TRIG")
- SET VAL=$PIECE(VAL,U,1)_"("_$PIECE(VAL,U,2)_")"
- +10 IF CODE="DM_EGFR"!(CODE="DM_UACR")
- SET VAL=$PIECE(VAL,U,2)_" ("_$PIECE(VAL,U,3)_")"
- +11 IF CODE="DM_TBTEST"
- SET VAL=$PIECE(VAL,"|",1)
- +12 IF CODE="DM_TBRES"
- SET VAL=$PIECE(VAL,"|",3)
- End DoDot:1
- +13 ;
- +14 IF VAL=""
- IF CODE="DM_DMTYP"
- Begin DoDot:1
- +15 DO CURR
- +16 DO @("TYPEDM^"_PGTHR)
- IF BDMTYDM'=""
- SET VAL=BDMTYDM
- End DoDot:1
- +17 DO FILD
- +18 QUIT
- +19 ;
- FILD ;EP - File the data
- +1 SET DA(2)=BQDFN
- SET DA(1)=PSRIEN
- SET X=CODE
- SET DIC(0)="L"
- SET DLAYGO=90507.561
- +2 SET DIC="^BQIPAT("_DA(2)_",60,"_DA(1)_",1,"
- +3 IF $GET(^BQIPAT(BQDFN,60,PSRIEN,1,0))=""
- SET ^BQIPAT(BQDFN,60,PSRIEN,1,0)="^90507.561^^"
- +4 DO ^DIC
- IF +Y=-1
- KILL DD,DO
- DO FILE^DICN
- +5 SET (CDRIEN,DA)=+Y
- +6 SET IENS=$$IENS^DILF(.DA)
- +7 SET BQIUPD(90507.561,IENS,.02)=$GET(VAL)
- +8 SET BQIUPD(90507.561,IENS,.03)=$GET(DATE)
- +9 SET BQIUPD(90507.561,IENS,.04)=$GET(VISIT)
- +10 SET BQIUPD(90507.561,IENS,.05)=$GET(OTHER)
- +11 KILL VAL,OTHER,DATE,VISIT
- +12 IF $DATA(BQIUPD)>0
- DO FILE^DIE("","BQIUPD","ERROR")
- +13 QUIT
- +14 ;
- CVAL(DFN) ; Get demographic values
- +1 ;Parameters
- +2 ; FIL = FileMan file number
- +3 ; FLD = FileMan field number
- +4 ; EXEC = If an executable is needed to determine value
- +5 ; HDR = Header value
- +6 ;the executable expects the value to be returned in variable VAL
- +7 NEW FIL,FLD,EXEC,RCODE,RGIEN,RIEN,RHDR,MVALUE,CODE
- +8 SET FIL=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",5)
- +9 SET FLD=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",6)
- +10 SET EXEC=$GET(^BQI(90506.1,STVW,5))
- +11 SET HDR=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",8)
- +12 IF $GET(DFN)=""
- SET VAL=""
- QUIT
- +13 ;
- +14 IF $GET(EXEC)'=""
- XECUTE EXEC
- QUIT
- +15 ;
- +16 IF FIL'=""
- IF FLD'=""
- SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
- +17 QUIT
- +18 ;
- +19 SET RCODE=$$GET1^DIQ(90506.1,STVW_",",.01,"E")
- +20 SET RGIEN=$ORDER(^BQI(90506.3,"AC",CRIEN,""))
- SET VAL=""
- +21 IF RGIEN'=""
- Begin DoDot:1
- +22 SET RIEN=$ORDER(^BQI(90506.3,RGIEN,10,"AC",RCODE,""))
- +23 IF RIEN'=""
- IF $PIECE($GET(^BQI(90506.3,RGIEN,10,RIEN,1)),U,1)="M"
- Begin DoDot:2
- +24 SET RHDR=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,2)
- SET MVALUE=""
- +25 NEW SNAME,SRIEN,SORD,SXREF,SIEN
- +26 SET SNAME=$PIECE(^BQI(90506.3,RGIEN,10,RIEN,0),U,1)
- +27 SET SRIEN=$ORDER(^BQI(90506.3,"B",SNAME,""))
- IF SRIEN=""
- QUIT
- +28 SET SORD=""
- SET SXREF=$SELECT($DATA(^BQI(90506.3,SRIEN,10,"AF")):"AF",1:"C")
- +29 FOR
- SET SORD=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD))
- IF SORD=""
- QUIT
- Begin DoDot:3
- +30 SET SIEN=""
- +31 FOR
- SET SIEN=$ORDER(^BQI(90506.3,SRIEN,10,SXREF,SORD,SIEN))
- IF SIEN=""
- QUIT
- Begin DoDot:4
- +32 IF $PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,4)'="S"
- QUIT
- +33 SET CODE=$PIECE(^BQI(90506.3,SRIEN,10,SIEN,0),U,7)
- IF CODE=""
- QUIT
- +34 SET STVW=$ORDER(^BQI(90506.1,"B",CODE,""))
- IF STVW=""
- QUIT
- +35 IF $PIECE($GET(^BQI(90506.1,STVW,0)),"^",10)=1
- QUIT
- +36 NEW FIL,FLD,EXEC
- +37 SET FIL=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",5)
- +38 SET FLD=$PIECE($GET(^BQI(90506.1,STVW,0)),"^",6)
- +39 SET EXEC=$GET(^BQI(90506.1,STVW,1))
- +40 SET HDR=RHDR
- +41 IF $GET(DFN)=""
- SET VAL=""
- QUIT
- +42 ;
- +43 IF $GET(EXEC)'=""
- XECUTE EXEC
- SET VAL=VAL_$SELECT(VAL'="":$CHAR(10),1:"")
- QUIT
- +44 IF FIL'=""
- IF FLD'=""
- SET VAL=$$GET1^DIQ(FIL,DFN_",",FLD,"E")
- +45 SET VALUE=VALUE_VAL_$SELECT(VAL'="":$CHAR(10),1:"")
- +46 SET VAL=VALUE
- End DoDot:4
- +47 SET MVALUE=MVALUE_$$TKO^BQIUL1(VAL,$CHAR(10))
- End DoDot:3
- +48 SET VAL=MVALUE
- End DoDot:2
- QUIT
- End DoDot:1
- IF VAL'=""
- QUIT
- +49 QUIT
- +50 ;
- CURR ;EP - Get current DM Audit information
- +1 SET CYR=$PIECE($GET(^BQI(90508,1,"DM")),U,1)
- +2 SET CIEN=$ORDER(^BQI(90508,1,21,"B",CYR,""))
- IF CIEN=""
- QUIT
- +3 SET PGTHR=$PIECE(^BQI(90508,1,21,CIEN,0),U,2)
- SET PGRF=$PIECE(^(0),U,4)
- +4 QUIT
