[613] | 1 | SCDXUTL1 ;ALB/JRP - GENERAL UTILITY ROUTINES;10-MAY-1996
|
---|
| 2 | ;;5.3;Scheduling;**44,60,132**;AUG 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | GETDTRNG(EARLIEST,LATEST,HELPBGN,HELPEND) ;Prompt user for a date range
|
---|
| 5 | ;
|
---|
| 6 | ;Input : EARLIEST - Earliest date allowed in FileMan format (Optional)
|
---|
| 7 | ; LATEST - Latest date allowed in FileMan format (Optional)
|
---|
| 8 | ; HELPBGN - Array containing help information for beginning
|
---|
| 9 | ; date (Full global reference) (Optional)
|
---|
| 10 | ; HELPEND - Array containing help information for ending
|
---|
| 11 | ; date (Full global reference) (Optional)
|
---|
| 12 | ;Output : Begin^End - Success
|
---|
| 13 | ; Begin - Beginning date
|
---|
| 14 | ; End - Ending date
|
---|
| 15 | ; -1 - User abort / timed out
|
---|
| 16 | ;Notes : HELPBGN & HELPEND arrays have same format as DIR("?",#) array
|
---|
| 17 | ;
|
---|
| 18 | ;Check input
|
---|
| 19 | S EARLIEST=$G(EARLIEST)
|
---|
| 20 | S LATEST=$G(LATEST)
|
---|
| 21 | S HELPBGN=$G(HELPBGN)
|
---|
| 22 | S HELPEND=$G(HELPEND)
|
---|
| 23 | ;Declare variables
|
---|
| 24 | N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,BEGIN,END
|
---|
| 25 | ;Get beginning date
|
---|
| 26 | S DIR(0)="DA^"_EARLIEST_":"_LATEST_":EPX"
|
---|
| 27 | S DIR("A")="Enter beginning date: "
|
---|
| 28 | I (HELPBGN'="") M DIR("?")=@HELPBGN
|
---|
| 29 | D ^DIR
|
---|
| 30 | S BEGIN=+Y
|
---|
| 31 | ;User abort / time out
|
---|
| 32 | Q:($D(DIRUT)) -1
|
---|
| 33 | ;Get ending date
|
---|
| 34 | K DIR
|
---|
| 35 | S DIR(0)="DA^"_BEGIN_":"_LATEST_":EPX"
|
---|
| 36 | S DIR("A")="Enter ending date: "
|
---|
| 37 | I (HELPEND'="") M DIR("?")=@HELPEND
|
---|
| 38 | D ^DIR
|
---|
| 39 | S END=+Y
|
---|
| 40 | ;User abort / time out
|
---|
| 41 | Q:($D(DIRUT)) -1
|
---|
| 42 | ;Done
|
---|
| 43 | Q BEGIN_"^"_END
|
---|
| 44 | ;
|
---|
| 45 | REPEAT(CHAR,TIMES) ;Repeat a string
|
---|
| 46 | ;INPUT : CHAR - Character to repeat
|
---|
| 47 | ; TIMES - Number of times to repeat CHAR
|
---|
| 48 | ;OUTPUT : s - String of CHAR that is TIMES long
|
---|
| 49 | ; "" - Error (bad input)
|
---|
| 50 | ;
|
---|
| 51 | ;Check input
|
---|
| 52 | Q:($G(CHAR)="") ""
|
---|
| 53 | Q:((+$G(TIMES))=0) ""
|
---|
| 54 | ;Return string
|
---|
| 55 | Q $TR($J("",TIMES)," ",CHAR)
|
---|
| 56 | ;
|
---|
| 57 | INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;Insert a string into another string
|
---|
| 58 | ;INPUT : INSTR - String to insert
|
---|
| 59 | ; OUTSTR - String to insert into
|
---|
| 60 | ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
|
---|
| 61 | ; LENGTH - Number of characters to clear from OUTSTR
|
---|
| 62 | ; (defaults to length of INSTR)
|
---|
| 63 | ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
|
---|
| 64 | ; using LENGTH characters
|
---|
| 65 | ; "" - Error (bad input)
|
---|
| 66 | ;
|
---|
| 67 | ;NOTE : This module is based on $$SETSTR^VALM1
|
---|
| 68 | ;
|
---|
| 69 | ;Check input
|
---|
| 70 | S INSTR=$G(INSTR)
|
---|
| 71 | Q:(INSTR="") $G(OUTSTR)
|
---|
| 72 | S OUTSTR=$G(OUTSTR)
|
---|
| 73 | S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
|
---|
| 74 | S:('$D(LENGTH)) LENGTH=$L(INSTR)
|
---|
| 75 | ;Declare variables
|
---|
| 76 | N FRONT,END
|
---|
| 77 | S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
|
---|
| 78 | S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
|
---|
| 79 | ;Insert string
|
---|
| 80 | Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
|
---|
| 81 | ;
|
---|
| 82 | DIAG(SDPOE,SCDXARRY) ;Get diagnoses from V POV file
|
---|
| 83 | ; Note: Returns Dx from children (if any)
|
---|
| 84 | ;
|
---|
| 85 | ; SDPOE - pointer to 409.68
|
---|
| 86 | ; SCDGARRY - output array
|
---|
| 87 | ;
|
---|
| 88 | N SCOPDX,SDCHILD,SDOE
|
---|
| 89 | D KIDS(SDPOE,"SDCHILD")
|
---|
| 90 | ;
|
---|
| 91 | ; -- get parent dxs
|
---|
| 92 | D GETDX^SDOE(+$G(SDPOE),SCDXARRY)
|
---|
| 93 | ;
|
---|
| 94 | ; -- get child dxs
|
---|
| 95 | S SDOE=0
|
---|
| 96 | F S SDOE=$O(SDCHILD(SDOE)) Q:'SDOE D
|
---|
| 97 | . D GETDX^SDOE(SDOE,SCDXARRY)
|
---|
| 98 | Q
|
---|
| 99 | ;
|
---|
| 100 | PRIMPDX(SDPOE) ; return pointer to ICD9 for primary dx of parent encounter
|
---|
| 101 | ; Note: Includes
|
---|
| 102 | ; SDPOE - encounter (parent)
|
---|
| 103 | ; return:
|
---|
| 104 | ; if one: ptr to ICD DIAGNOSIS file (ICD9)^pointer to V POV file
|
---|
| 105 | ; if none: no prim dx
|
---|
| 106 | ; if two+: -1 (error)
|
---|
| 107 | ;
|
---|
| 108 | N SCDX,SCX,SCDX1,SDCHILD,SDOE
|
---|
| 109 | S SCDX1=0
|
---|
| 110 | D DIAG(.SDPOE,"SCDX")
|
---|
| 111 | S SCX=0
|
---|
| 112 | F S SCX=$O(SCDX(SCX)) Q:'SCX IF $P(SCDX(SCX),U,12)="P" S:SCDX1 SCDX1=-1 Q:SCDX1 S SCDX1=(+SCDX(SCX))_U_SCX
|
---|
| 113 | Q SCDX1
|
---|
| 114 | ;
|
---|
| 115 | KIDS(SDOE,SCKIDS) ;return children of parent
|
---|
| 116 | ; Input - SDOE = ptr to 409.68
|
---|
| 117 | ; Output- @SCKIDS@(kid ptr to 409.68) array
|
---|
| 118 | N SCX
|
---|
| 119 | S SCX=0 F S SCX=$O(^SCE("APAR",SDOE,SCX)) Q:'SCX S @SCKIDS@(SCX)=""
|
---|
| 120 | Q
|
---|