| 1 | ORRHCU ; SLC/KCM - CPRS Query Tools - Utilities ; [8/6/03 1:27Pm]
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174**;Dec 17, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | NXT() ; Increment ILST
|
|---|
| 5 | S ILST=ILST+1
|
|---|
| 6 | Q ILST
|
|---|
| 7 | ;
|
|---|
| 8 | RNG2FM(RNG) ; convert a relative date range to Fileman dates
|
|---|
| 9 | N FMRNG
|
|---|
| 10 | I $E(RNG,1)="Y" D
|
|---|
| 11 | . N YR,TYP,QTR
|
|---|
| 12 | . S YR=$E(DT,1,3),TYP=$E(RNG,2) I (TYP="F"),(+$E(DT,4,5)>9) S YR=YR+1
|
|---|
| 13 | . S YR=YR+$E(RNG,3,999)
|
|---|
| 14 | . I (RNG["Q"),($P(RNG,"Q",2)="") S RNG=RNG_$$CURQTR($E(RNG,2)="F")
|
|---|
| 15 | . I $P(RNG,"Q",2)="" D Q
|
|---|
| 16 | . . I TYP="C" S FMRNG=YR_"0101:"_YR_"1231"
|
|---|
| 17 | . . I TYP="F" S FMRNG=(YR-1)_"1001:"_YR_"0930"
|
|---|
| 18 | . S QTR=+$P(RNG,"Q",2)
|
|---|
| 19 | . I TYP="F" S:QTR=1 YR=YR-1 S QTR=QTR-1 S:QTR=0 QTR=4
|
|---|
| 20 | . S FMRNG=YR_$P("0101^0401^0701^1001",U,QTR)_":"_YR
|
|---|
| 21 | . S FMRNG=FMRNG_$P("0331^0630^0930^1231",U,QTR)
|
|---|
| 22 | E D
|
|---|
| 23 | . N BDT,EDT,%DT,X,Y
|
|---|
| 24 | . S BDT=$P(RNG,":",1),EDT=$P(RNG,":",2)
|
|---|
| 25 | . I $L(BDT) S X=BDT D ^%DT S BDT=Y
|
|---|
| 26 | . I $L(EDT) S X=EDT D ^%DT S EDT=Y
|
|---|
| 27 | . I '$L(BDT) S BDT=0
|
|---|
| 28 | . I '$L(EDT) S EDT=9999999
|
|---|
| 29 | . S FMRNG=BDT_":"_EDT
|
|---|
| 30 | Q FMRNG
|
|---|
| 31 | CURQTR(ISFY) ; return the current fiscal or calendar quarter
|
|---|
| 32 | N QTR
|
|---|
| 33 | S QTR=$P(($E(DT,4,5)-1)/3,".")+1
|
|---|
| 34 | I ISFY S QTR=QTR+1 S:QTR=5 QTR=1
|
|---|
| 35 | Q QTR
|
|---|
| 36 | ID2EXT(LST,FN,IDLST) ; Return the external values for a set if IENs
|
|---|
| 37 | N I
|
|---|
| 38 | S I=0 F S I=$O(IDLST(I)) Q:'I D
|
|---|
| 39 | . I +IDLST(I)=0 S LST(I)=IDLST(I) Q
|
|---|
| 40 | . S LST(I)=IDLST(I)_U_$$GET1^DIQ(FN,IDLST(I),.01)
|
|---|
| 41 | Q
|
|---|
| 42 | BYREG(LST,NAM,MOD) ; List patients from registry
|
|---|
| 43 | N ILST,RC,ITR,PATID S ILST=0
|
|---|
| 44 | I $$PATITER^RORAPI01(.ITR,NAM,MOD)<0 Q
|
|---|
| 45 | F S RC=$$NEXTPAT^RORAPI01(.ITR) Q:RC'>0 D
|
|---|
| 46 | . S PATID=$P(RC,U)
|
|---|
| 47 | . S LST($$NXT)=PATID_U_$P(^DPT(PATID,0),U)
|
|---|
| 48 | Q
|
|---|
| 49 | REGLST(LST) ; List available local registries
|
|---|
| 50 | S LST(1)="VA HEPC^Local HepC Registry"
|
|---|
| 51 | Q
|
|---|
| 52 | REGNAM(VAL,ID) ; Return the full name of a registry
|
|---|
| 53 | S VAL="Unknown Registry"
|
|---|
| 54 | I ID="VA HEPC" S VAL="Local HepC Registry"
|
|---|
| 55 | Q
|
|---|
| 56 | NMVAL(NM,VAL) ; Set a name=value pair
|
|---|
| 57 | Q:NM="" Q:VAL=""
|
|---|
| 58 | S LST($$NXT)=NM_"="_VAL
|
|---|
| 59 | Q
|
|---|
| 60 | DFLDS(LST,TYP) ; List display fields
|
|---|
| 61 | N I,J,ILST,X0 S ILST=0
|
|---|
| 62 | S TYP=$$DFLDTRAN(TYP) ; consults, orders return same fields
|
|---|
| 63 | S I=0 F S I=$O(^ORD(102.24,I)) Q:'I D
|
|---|
| 64 | . S X0=^ORD(102.24,I,0)
|
|---|
| 65 | . Q:TYP'[$E(X0) ; 1st char of name corresponds to type
|
|---|
| 66 | . ; S LST($$NXT)=X0
|
|---|
| 67 | . D NMVAL("DisplayName",$P(X0,U,2)) ; must be first
|
|---|
| 68 | . D NMVAL("InternalName",$P(X0,U))
|
|---|
| 69 | . D NMVAL("HeaderName",$P(X0,U,3))
|
|---|
| 70 | . D NMVAL("SortType",$P(X0,U,4))
|
|---|
| 71 | . S J=0 F S J=$O(^ORD(102.24,I,1,J)) Q:'J D
|
|---|
| 72 | . . D NMVAL("SampleData",$G(^ORD(102.24,I,1,J,0)))
|
|---|
| 73 | Q
|
|---|
| 74 | COLTYP(LST,SRC) ; List the column types
|
|---|
| 75 | N I,IEN
|
|---|
| 76 | S I=0 F S I=$O(SRC(I)) Q:'I D
|
|---|
| 77 | . S IEN=$O(^ORD(102.24,"B",SRC(I),0))
|
|---|
| 78 | . I 'IEN S LST(I)=SRC(I)_"^0"
|
|---|
| 79 | . E S LST(I)=SRC(I)_U_$P($G(^ORD(102.24,IEN,0)),U,4)
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | DFLDMAP(LST) ; Returns a mapping of constraint types to display field types
|
|---|
| 83 | N FLDLIST S FLDLIST=$$GETFLDLS
|
|---|
| 84 | N TRANSLST S TRANSLST=$$DFLDTRAN(FLDLIST)
|
|---|
| 85 | N I S I=0
|
|---|
| 86 | F S I=I+1 Q:I>$L(FLDLIST) D
|
|---|
| 87 | .S LST(I)=$E(FLDLIST,I)_"="_$E(TRANSLST,I)
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | DFLDTRAN(FLD) ;Translates the constraint types to the display field types
|
|---|
| 91 | Q $TR(FLD,"C","O")
|
|---|
| 92 | ;
|
|---|
| 93 | GETFLDLS() ;Returns a list of defined display fields
|
|---|
| 94 | N LIST
|
|---|
| 95 | S LIST="PODVC"
|
|---|
| 96 | Q LIST
|
|---|
| 97 | ;
|
|---|
