SCDXUTL1 ;ALB/JRP - GENERAL UTILITY ROUTINES;10-MAY-1996
;;5.3;Scheduling;**44,60,132,1015**;AUG 13, 1993;Build 21
;
GETDTRNG(EARLIEST,LATEST,HELPBGN,HELPEND) ;Prompt user for a date range
;
;Input : EARLIEST - Earliest date allowed in FileMan format (Optional)
; LATEST - Latest date allowed in FileMan format (Optional)
; HELPBGN - Array containing help information for beginning
; date (Full global reference) (Optional)
; HELPEND - Array containing help information for ending
; date (Full global reference) (Optional)
;Output : Begin^End - Success
; Begin - Beginning date
; End - Ending date
; -1 - User abort / timed out
;Notes : HELPBGN & HELPEND arrays have same format as DIR("?",#) array
;
;Check input
S EARLIEST=$G(EARLIEST)
S LATEST=$G(LATEST)
S HELPBGN=$G(HELPBGN)
S HELPEND=$G(HELPEND)
;Declare variables
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,BEGIN,END
;Get beginning date
S DIR(0)="DA^"_EARLIEST_":"_LATEST_":EPX"
S DIR("A")="Enter beginning date: "
I (HELPBGN'="") M DIR("?")=@HELPBGN
D ^DIR
S BEGIN=+Y
;User abort / time out
Q:($D(DIRUT)) -1
;Get ending date
K DIR
S DIR(0)="DA^"_BEGIN_":"_LATEST_":EPX"
S DIR("A")="Enter ending date: "
I (HELPEND'="") M DIR("?")=@HELPEND
D ^DIR
S END=+Y
;User abort / time out
Q:($D(DIRUT)) -1
;Done
Q BEGIN_"^"_END
;
REPEAT(CHAR,TIMES) ;Repeat a string
;INPUT : CHAR - Character to repeat
; TIMES - Number of times to repeat CHAR
;OUTPUT : s - String of CHAR that is TIMES long
; "" - Error (bad input)
;
;Check input
Q:($G(CHAR)="") ""
Q:((+$G(TIMES))=0) ""
;Return string
Q $TR($J("",TIMES)," ",CHAR)
;
INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;Insert a string into another string
;INPUT : INSTR - String to insert
; OUTSTR - String to insert into
; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
; LENGTH - Number of characters to clear from OUTSTR
; (defaults to length of INSTR)
;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
; using LENGTH characters
; "" - Error (bad input)
;
;NOTE : This module is based on $$SETSTR^VALM1
;
;Check input
S INSTR=$G(INSTR)
Q:(INSTR="") $G(OUTSTR)
S OUTSTR=$G(OUTSTR)
S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
S:('$D(LENGTH)) LENGTH=$L(INSTR)
;Declare variables
N FRONT,END
S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
;Insert string
Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
;
DIAG(SDPOE,SCDXARRY) ;Get diagnoses from V POV file
; Note: Returns Dx from children (if any)
;
; SDPOE - pointer to 409.68
; SCDGARRY - output array
;
N SCOPDX,SDCHILD,SDOE
D KIDS(SDPOE,"SDCHILD")
;
; -- get parent dxs
D GETDX^SDOE(+$G(SDPOE),SCDXARRY)
;
; -- get child dxs
S SDOE=0
F S SDOE=$O(SDCHILD(SDOE)) Q:'SDOE D
. D GETDX^SDOE(SDOE,SCDXARRY)
Q
;
PRIMPDX(SDPOE) ; return pointer to ICD9 for primary dx of parent encounter
; Note: Includes
; SDPOE - encounter (parent)
; return:
; if one: ptr to ICD DIAGNOSIS file (ICD9)^pointer to V POV file
; if none: no prim dx
; if two+: -1 (error)
;
N SCDX,SCX,SCDX1,SDCHILD,SDOE
S SCDX1=0
D DIAG(.SDPOE,"SCDX")
S SCX=0
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
Q SCDX1
;
KIDS(SDOE,SCKIDS) ;return children of parent
; Input - SDOE = ptr to 409.68
; Output- @SCKIDS@(kid ptr to 409.68) array
N SCX
S SCX=0 F S SCX=$O(^SCE("APAR",SDOE,SCX)) Q:'SCX S @SCKIDS@(SCX)=""
Q
SCDXUTL1 ;ALB/JRP - GENERAL UTILITY ROUTINES;10-MAY-1996
+1 ;;5.3;Scheduling;**44,60,132,1015**;AUG 13, 1993;Build 21
+2 ;
GETDTRNG(EARLIEST,LATEST,HELPBGN,HELPEND) ;Prompt user for a date range
+1 ;
+2 ;Input : EARLIEST - Earliest date allowed in FileMan format (Optional)
+3 ; LATEST - Latest date allowed in FileMan format (Optional)
+4 ; HELPBGN - Array containing help information for beginning
+5 ; date (Full global reference) (Optional)
+6 ; HELPEND - Array containing help information for ending
+7 ; date (Full global reference) (Optional)
+8 ;Output : Begin^End - Success
+9 ; Begin - Beginning date
+10 ; End - Ending date
+11 ; -1 - User abort / timed out
+12 ;Notes : HELPBGN & HELPEND arrays have same format as DIR("?",#) array
+13 ;
+14 ;Check input
+15 SET EARLIEST=$GET(EARLIEST)
+16 SET LATEST=$GET(LATEST)
+17 SET HELPBGN=$GET(HELPBGN)
+18 SET HELPEND=$GET(HELPEND)
+19 ;Declare variables
+20 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,BEGIN,END
+21 ;Get beginning date
+22 SET DIR(0)="DA^"_EARLIEST_":"_LATEST_":EPX"
+23 SET DIR("A")="Enter beginning date: "
+24 IF (HELPBGN'="")
MERGE DIR("?")=@HELPBGN
+25 DO ^DIR
+26 SET BEGIN=+Y
+27 ;User abort / time out
+28 IF ($DATA(DIRUT))
QUIT -1
+29 ;Get ending date
+30 KILL DIR
+31 SET DIR(0)="DA^"_BEGIN_":"_LATEST_":EPX"
+32 SET DIR("A")="Enter ending date: "
+33 IF (HELPEND'="")
MERGE DIR("?")=@HELPEND
+34 DO ^DIR
+35 SET END=+Y
+36 ;User abort / time out
+37 IF ($DATA(DIRUT))
QUIT -1
+38 ;Done
+39 QUIT BEGIN_"^"_END
+40 ;
REPEAT(CHAR,TIMES) ;Repeat a string
+1 ;INPUT : CHAR - Character to repeat
+2 ; TIMES - Number of times to repeat CHAR
+3 ;OUTPUT : s - String of CHAR that is TIMES long
+4 ; "" - Error (bad input)
+5 ;
+6 ;Check input
+7 IF ($GET(CHAR)="")
QUIT ""
+8 IF ((+$GET(TIMES))=0)
QUIT ""
+9 ;Return string
+10 QUIT $TRANSLATE($JUSTIFY("",TIMES)," ",CHAR)
+11 ;
INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;Insert a string into another string
+1 ;INPUT : INSTR - String to insert
+2 ; OUTSTR - String to insert into
+3 ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
+4 ; LENGTH - Number of characters to clear from OUTSTR
+5 ; (defaults to length of INSTR)
+6 ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
+7 ; using LENGTH characters
+8 ; "" - Error (bad input)
+9 ;
+10 ;NOTE : This module is based on $$SETSTR^VALM1
+11 ;
+12 ;Check input
+13 SET INSTR=$GET(INSTR)
+14 IF (INSTR="")
QUIT $GET(OUTSTR)
+15 SET OUTSTR=$GET(OUTSTR)
+16 IF ('$DATA(COLUMN))
SET COLUMN=$LENGTH(OUTSTR)+1
+17 IF ('$DATA(LENGTH))
SET LENGTH=$LENGTH(INSTR)
+18 ;Declare variables
+19 NEW FRONT,END
+20 SET FRONT=$EXTRACT((OUTSTR_$JUSTIFY("",COLUMN-1)),1,(COLUMN-1))
+21 SET END=$EXTRACT(OUTSTR,(COLUMN+LENGTH),$LENGTH(OUTSTR))
+22 ;Insert string
+23 QUIT FRONT_$EXTRACT((INSTR_$JUSTIFY("",LENGTH)),1,LENGTH)_END
+24 ;
DIAG(SDPOE,SCDXARRY) ;Get diagnoses from V POV file
+1 ; Note: Returns Dx from children (if any)
+2 ;
+3 ; SDPOE - pointer to 409.68
+4 ; SCDGARRY - output array
+5 ;
+6 NEW SCOPDX,SDCHILD,SDOE
+7 DO KIDS(SDPOE,"SDCHILD")
+8 ;
+9 ; -- get parent dxs
+10 DO GETDX^SDOE(+$GET(SDPOE),SCDXARRY)
+11 ;
+12 ; -- get child dxs
+13 SET SDOE=0
+14 FOR
SET SDOE=$ORDER(SDCHILD(SDOE))
IF 'SDOE
QUIT
Begin DoDot:1
+15 DO GETDX^SDOE(SDOE,SCDXARRY)
End DoDot:1
+16 QUIT
+17 ;
PRIMPDX(SDPOE) ; return pointer to ICD9 for primary dx of parent encounter
+1 ; Note: Includes
+2 ; SDPOE - encounter (parent)
+3 ; return:
+4 ; if one: ptr to ICD DIAGNOSIS file (ICD9)^pointer to V POV file
+5 ; if none: no prim dx
+6 ; if two+: -1 (error)
+7 ;
+8 NEW SCDX,SCX,SCDX1,SDCHILD,SDOE
+9 SET SCDX1=0
+10 DO DIAG(.SDPOE,"SCDX")
+11 SET SCX=0
+12 FOR
SET SCX=$ORDER(SCDX(SCX))
IF 'SCX
QUIT
IF $PIECE(SCDX(SCX),U,12)="P"
IF SCDX1
SET SCDX1=-1
IF SCDX1
QUIT
SET SCDX1=(+SCDX(SCX))_U_SCX
+13 QUIT SCDX1
+14 ;
KIDS(SDOE,SCKIDS) ;return children of parent
+1 ; Input - SDOE = ptr to 409.68
+2 ; Output- @SCKIDS@(kid ptr to 409.68) array
+3 NEW SCX
+4 SET SCX=0
FOR
SET SCX=$ORDER(^SCE("APAR",SDOE,SCX))
IF 'SCX
QUIT
SET @SCKIDS@(SCX)=""
+5 QUIT
