- SCDXUTL1 ;ALB/JRP - GENERAL UTILITY ROUTINES;10-MAY-1996
- ;;5.3;Scheduling;**44,60,132**;AUG 13, 1993
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCDXUTL1 3742 printed Jan 18, 2025@03:40:48 Page 2
- SCDXUTL1 ;ALB/JRP - GENERAL UTILITY ROUTINES;10-MAY-1996
- +1 ;;5.3;Scheduling;**44,60,132**;AUG 13, 1993
- +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