VAFCMGU0 ;ALB/JRP-MERGE SCREEN UTILITIES ;10/18/96
;;5.3;Registration;**149,295,479**;Aug 13, 1993
;
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
;
;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
Q:('$D(INSTR)) ""
Q:('$D(OUTSTR)) ""
S:('$D(COLUMN)) COLUMN=$L(OUTSTR)+1
S:('$D(LENGTH)) LENGTH=$L(INSTR)
;Declare variables
N FRONT,END
;Get front portion of new string
S FRONT=$E((OUTSTR_$J("",COLUMN-1)),1,(COLUMN-1))
;Get ending portion of new string
S END=$E(OUTSTR,(COLUMN+LENGTH),$L(OUTSTR))
;Insert string
Q FRONT_$E((INSTR_$J("",LENGTH)),1,LENGTH)_END
;
CENTER(CNTRSTR,MARGIN) ;Center a string
;
;INPUT : CNTRSTR - String to center
; MARGIN - Margin width to center within (defaults to 80)
;OUTPUT : s - INSTR will be centered in a margin width of MARGIN
; "" - Error (bad input)
;NOTES : A margin width of 80 will be used when MARGIN<1
; : CNTRSTR will be returned when $L(CNTRSTR)>MARGIN
;
;Check input
Q:($G(CNTRSTR)="") ""
S:($G(MARGIN)<1) MARGIN=80
;Center the string
Q $$INSERT(CNTRSTR,"",((MARGIN\2)-($L(CNTRSTR)\2)))
;
IN2EXDT(DATE,STYLE) ;Converts dates from internal to external format
;
;Input : DATE - Date in FileMan format
; STYLE - Flag indicating output style
; If 0, return date in format MM-DD-YYYY (Default)
; If 1, return date in format MMM DD, YYYY
; (MMM -> first three characters of month)
;Output : External date in specified format
;Notes : Time will NOT be included, even if present on input
; : NULL ("") is returned on bad input
;
;Check input
S DATE=+$P($G(DATE),".",1)
Q:('DATE) ""
Q:(DATE'?7N) ""
S STYLE=+$G(STYLE)
;Return date in MM-DD-YYYY format
Q:('STYLE) $E(DATE,4,5)_"-"_$E(DATE,6,7)_"-"_($E(DATE,1,3)+1700)
;Declare variables
N Y,%DT
;Return date in MMM DD, YYYY format
S Y=DATE
D DD^%DT
Q Y
;
EX2INDT(DATE) ;Converts dates from external to internal format
;
;Input : Date in external format
;Output : Date in FileMan format
;Notes : Time will be included if present on input
; : NULL ("") is returned on bad input
;
;Check input
S DATE=$G(DATE)
Q:(DATE="") ""
;Declare variables
N X,%DT,Y
;Convert date
S DATE=$P(DATE,"@",1) ;**295 strip time off
I $L(DATE,"/")=3,'$P(DATE,"/",2) S DATE=$P(DATE,"/",1)_"/"_$P(DATE,"/",3) ;**295 imprecise date - ##/00/#### to ##/####
I $L(DATE,"/")=2,'$P(DATE,"/",1) S DATE=$P(DATE,"/",2) ;**295 imprecise date - 00/#### to ####
S X=DATE
S %DT="TS"
D ^%DT
Q:(Y=-1) ""
Q Y
;
NOW(FMFORM,NOTIME) ;Returns current date/time
;
;Input : FMFORM - Flag indicating if FileMan format should be used
; If 0, return in the format MM-DD-YYYY@HH:MM:SS
; (default)
; If 1, return in FileMan format
; NOTIME - Flag indicating if time should not be included
; If 0, time will be included in output (default)
; If 1, time will not be included in output
;Output : Current date & time in specified format
;
;Check input
S FMFORM=+$G(FMFORM)
S NOTIME=+$G(NOTIME)
;Declare variables
N X,%,%H,%I,OUT
;Get current date/time
D NOW^%DTC
;Return date/time in FileMan format
Q:(FMFORM) $S(NOTIME:X,1:%)
;Return date/time in MM-DD-YYYY@HH:MM:SS format
S %=%_"000000"
S OUT=$E(%,4,5)_"-"_$E(%,6,7)_"-"_(1700+$E(%,1,3))
S:('NOTIME) OUT=OUT_"@"_$E(%,9,10)_":"_$E(%,11,12)_":"_$E(%,13,14)
Q OUT
;
GETDATA(DFN,GROUP,TARGET,MESSAGE) ;Get local data required to build
; merge screens for a given patient
;
;Input : DFN - Pointer to entry in PATIENT file (#2)
; GROUP - Group number to get data for (defaults to 1)
; Group 1 = Name, SSN, date of birth & date of death
; TARGET - Array to store data in (full global reference)
; Defaults to ^TMP("VAFC-MERGE-TO",$J,"DATA")
; MESSAGE - Array to store error data in (full global reference)
; Defaults to ^TMP("VAFC-MERGE-TO",$J,"MESSAGE")
;Output : None
; TARGET & MESSAGE will be in the format defined by FileMan
; for interaction with the Database Server calls. Refer to
; the FileMan documentation on GETS^DIQ() for further
; information.
;Notes : All data will be in external format
; : Groups 1 - 4 are currently supported
; : Initialization of TARGET & MESSAGE is defined by the call
; to GETS^DIQ(). Refer to the FileMan documentation for
; further details.
;
;Check input
S DFN=+$G(DFN)
S GROUP=+$G(GROUP)
S:((GROUP<1)!(GROUP>4)) GROUP=0
S TARGET=$G(TARGET)
S:(TARGET="") TARGET="^TMP(""VAFC-MERGE-TO"","_$J_",""DATA"")"
S MESSAGE=$G(MESSAGE)
S:(MESSAGE="") MESSAGE="^TMP(""VAFC-MERGE-TO"","_$J_",""MESSAGE"")"
;Declare variables
N IENS,FIELDS ;,COUNTY ;**479
S IENS=DFN_","
;S COUNTY=0 ;**479
;Group 1
S FIELDS=".01;.03;.09;.351"
;Group 2
I (GROUP=2) D
.S FIELDS=".131;.132" ;".111;.1112;.112;.113;.114;.115;.117;.131;.132" ;**479
.;Remember that COUNTY (field #.117) was retrieved
.;S COUNTY=1 ;**479
;Group 3
I (GROUP=3) D
.S FIELDS=".02;.05;.08;.211;.219;.2403;.31115"
;Group 4
I (GROUP=4) D
.S FIELDS=".301;.302;.323;.361;.3612;.3615;.3616;391;1901"
;Extract data
D GETS^DIQ(2,IENS,FIELDS,"",TARGET,MESSAGE)
;Accomodate for incorrect extraction of COUNTY (field #.117)
;S:(COUNTY) @TARGET@(2,IENS,.117)=$$COUNTY(DFN) ;**479
;Done
Q
;
COUNTY(DFN) ;Return county name that patient lives in
;
;Input : DFN - Pointer to entry in PATIENT file (#2)
;Output : County - Name of county that patient lives in
;Notes : NULL is returned on error, bad input, and no county found
;
;Check input
S DFN=+$G(DFN)
;Declare variables
N IENS,PTRCNTY,PTRSTATE,TMP
;Get pointers to STATE file and COUNTY sub-file
S IENS=DFN_","
D GETS^DIQ(2,IENS,".115;.117","I","TMP","TMP")
S PTRSTATE=+$G(TMP(2,IENS,.115,"I"))
S PTRCNTY=+$G(TMP(2,IENS,.117,"I"))
Q:(('PTRSTATE)!('PTRCNTY)) ""
;Get county name
S IENS=PTRCNTY_","_PTRSTATE_","
D GETS^DIQ(5.01,IENS,".01","","TMP","TMP")
;Return county name
Q $G(TMP(5.01,IENS,.01))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCMGU0 7086 printed Jan 18, 2025@04:02:35 Page 2
VAFCMGU0 ;ALB/JRP-MERGE SCREEN UTILITIES ;10/18/96
+1 ;;5.3;Registration;**149,295,479**;Aug 13, 1993
+2 ;
REPEAT(CHAR,TIMES) ;Repeat a string
+1 ;
+2 ;INPUT : CHAR - Character to repeat
+3 ; TIMES - Number of times to repeat CHAR
+4 ;OUTPUT : s - String of CHAR that is TIMES long
+5 ; "" - Error (bad input)
+6 ;
+7 ;Check input
+8 if ($GET(CHAR)="")
QUIT ""
+9 if ((+$GET(TIMES))=0)
QUIT ""
+10 ;Return string
+11 QUIT $TRANSLATE($JUSTIFY("",TIMES)," ",CHAR)
+12 ;
INSERT(INSTR,OUTSTR,COLUMN,LENGTH) ;Insert a string into another
+1 ;
+2 ;INPUT : INSTR - String to insert
+3 ; OUTSTR - String to insert into
+4 ; COLUMN - Where to begin insertion (defaults to end of OUTSTR)
+5 ; LENGTH - Number of characters to clear from OUTSTR
+6 ; (defaults to length of INSTR)
+7 ;OUTPUT : s - INSTR will be placed into OUTSTR starting at COLUMN
+8 ; using LENGTH characters
+9 ; "" - Error (bad input)
+10 ;
+11 ;NOTE : This module is based on $$SETSTR^VALM1
+12 ;
+13 ;Check input
+14 if ('$DATA(INSTR))
QUIT ""
+15 if ('$DATA(OUTSTR))
QUIT ""
+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 ;Get front portion of new string
+21 SET FRONT=$EXTRACT((OUTSTR_$JUSTIFY("",COLUMN-1)),1,(COLUMN-1))
+22 ;Get ending portion of new string
+23 SET END=$EXTRACT(OUTSTR,(COLUMN+LENGTH),$LENGTH(OUTSTR))
+24 ;Insert string
+25 QUIT FRONT_$EXTRACT((INSTR_$JUSTIFY("",LENGTH)),1,LENGTH)_END
+26 ;
CENTER(CNTRSTR,MARGIN) ;Center a string
+1 ;
+2 ;INPUT : CNTRSTR - String to center
+3 ; MARGIN - Margin width to center within (defaults to 80)
+4 ;OUTPUT : s - INSTR will be centered in a margin width of MARGIN
+5 ; "" - Error (bad input)
+6 ;NOTES : A margin width of 80 will be used when MARGIN<1
+7 ; : CNTRSTR will be returned when $L(CNTRSTR)>MARGIN
+8 ;
+9 ;Check input
+10 if ($GET(CNTRSTR)="")
QUIT ""
+11 if ($GET(MARGIN)<1)
SET MARGIN=80
+12 ;Center the string
+13 QUIT $$INSERT(CNTRSTR,"",((MARGIN\2)-($LENGTH(CNTRSTR)\2)))
+14 ;
IN2EXDT(DATE,STYLE) ;Converts dates from internal to external format
+1 ;
+2 ;Input : DATE - Date in FileMan format
+3 ; STYLE - Flag indicating output style
+4 ; If 0, return date in format MM-DD-YYYY (Default)
+5 ; If 1, return date in format MMM DD, YYYY
+6 ; (MMM -> first three characters of month)
+7 ;Output : External date in specified format
+8 ;Notes : Time will NOT be included, even if present on input
+9 ; : NULL ("") is returned on bad input
+10 ;
+11 ;Check input
+12 SET DATE=+$PIECE($GET(DATE),".",1)
+13 if ('DATE)
QUIT ""
+14 if (DATE'?7N)
QUIT ""
+15 SET STYLE=+$GET(STYLE)
+16 ;Return date in MM-DD-YYYY format
+17 if ('STYLE)
QUIT $EXTRACT(DATE,4,5)_"-"_$EXTRACT(DATE,6,7)_"-"_($EXTRACT(DATE,1,3)+1700)
+18 ;Declare variables
+19 NEW Y,%DT
+20 ;Return date in MMM DD, YYYY format
+21 SET Y=DATE
+22 DO DD^%DT
+23 QUIT Y
+24 ;
EX2INDT(DATE) ;Converts dates from external to internal format
+1 ;
+2 ;Input : Date in external format
+3 ;Output : Date in FileMan format
+4 ;Notes : Time will be included if present on input
+5 ; : NULL ("") is returned on bad input
+6 ;
+7 ;Check input
+8 SET DATE=$GET(DATE)
+9 if (DATE="")
QUIT ""
+10 ;Declare variables
+11 NEW X,%DT,Y
+12 ;Convert date
+13 ;**295 strip time off
SET DATE=$PIECE(DATE,"@",1)
+14 ;**295 imprecise date - ##/00/#### to ##/####
IF $LENGTH(DATE,"/")=3
IF '$PIECE(DATE,"/",2)
SET DATE=$PIECE(DATE,"/",1)_"/"_$PIECE(DATE,"/",3)
+15 ;**295 imprecise date - 00/#### to ####
IF $LENGTH(DATE,"/")=2
IF '$PIECE(DATE,"/",1)
SET DATE=$PIECE(DATE,"/",2)
+16 SET X=DATE
+17 SET %DT="TS"
+18 DO ^%DT
+19 if (Y=-1)
QUIT ""
+20 QUIT Y
+21 ;
NOW(FMFORM,NOTIME) ;Returns current date/time
+1 ;
+2 ;Input : FMFORM - Flag indicating if FileMan format should be used
+3 ; If 0, return in the format MM-DD-YYYY@HH:MM:SS
+4 ; (default)
+5 ; If 1, return in FileMan format
+6 ; NOTIME - Flag indicating if time should not be included
+7 ; If 0, time will be included in output (default)
+8 ; If 1, time will not be included in output
+9 ;Output : Current date & time in specified format
+10 ;
+11 ;Check input
+12 SET FMFORM=+$GET(FMFORM)
+13 SET NOTIME=+$GET(NOTIME)
+14 ;Declare variables
+15 NEW X,%,%H,%I,OUT
+16 ;Get current date/time
+17 DO NOW^%DTC
+18 ;Return date/time in FileMan format
+19 if (FMFORM)
QUIT $SELECT(NOTIME:X,1:%)
+20 ;Return date/time in MM-DD-YYYY@HH:MM:SS format
+21 SET %=%_"000000"
+22 SET OUT=$EXTRACT(%,4,5)_"-"_$EXTRACT(%,6,7)_"-"_(1700+$EXTRACT(%,1,3))
+23 if ('NOTIME)
SET OUT=OUT_"@"_$EXTRACT(%,9,10)_":"_$EXTRACT(%,11,12)_":"_$EXTRACT(%,13,14)
+24 QUIT OUT
+25 ;
GETDATA(DFN,GROUP,TARGET,MESSAGE) ;Get local data required to build
+1 ; merge screens for a given patient
+2 ;
+3 ;Input : DFN - Pointer to entry in PATIENT file (#2)
+4 ; GROUP - Group number to get data for (defaults to 1)
+5 ; Group 1 = Name, SSN, date of birth & date of death
+6 ; TARGET - Array to store data in (full global reference)
+7 ; Defaults to ^TMP("VAFC-MERGE-TO",$J,"DATA")
+8 ; MESSAGE - Array to store error data in (full global reference)
+9 ; Defaults to ^TMP("VAFC-MERGE-TO",$J,"MESSAGE")
+10 ;Output : None
+11 ; TARGET & MESSAGE will be in the format defined by FileMan
+12 ; for interaction with the Database Server calls. Refer to
+13 ; the FileMan documentation on GETS^DIQ() for further
+14 ; information.
+15 ;Notes : All data will be in external format
+16 ; : Groups 1 - 4 are currently supported
+17 ; : Initialization of TARGET & MESSAGE is defined by the call
+18 ; to GETS^DIQ(). Refer to the FileMan documentation for
+19 ; further details.
+20 ;
+21 ;Check input
+22 SET DFN=+$GET(DFN)
+23 SET GROUP=+$GET(GROUP)
+24 if ((GROUP<1)!(GROUP>4))
SET GROUP=0
+25 SET TARGET=$GET(TARGET)
+26 if (TARGET="")
SET TARGET="^TMP(""VAFC-MERGE-TO"","_$JOB_",""DATA"")"
+27 SET MESSAGE=$GET(MESSAGE)
+28 if (MESSAGE="")
SET MESSAGE="^TMP(""VAFC-MERGE-TO"","_$JOB_",""MESSAGE"")"
+29 ;Declare variables
+30 ;,COUNTY ;**479
NEW IENS,FIELDS
+31 SET IENS=DFN_","
+32 ;S COUNTY=0 ;**479
+33 ;Group 1
+34 SET FIELDS=".01;.03;.09;.351"
+35 ;Group 2
+36 IF (GROUP=2)
Begin DoDot:1
+37 ;".111;.1112;.112;.113;.114;.115;.117;.131;.132" ;**479
SET FIELDS=".131;.132"
+38 ;Remember that COUNTY (field #.117) was retrieved
+39 ;S COUNTY=1 ;**479
End DoDot:1
+40 ;Group 3
+41 IF (GROUP=3)
Begin DoDot:1
+42 SET FIELDS=".02;.05;.08;.211;.219;.2403;.31115"
End DoDot:1
+43 ;Group 4
+44 IF (GROUP=4)
Begin DoDot:1
+45 SET FIELDS=".301;.302;.323;.361;.3612;.3615;.3616;391;1901"
End DoDot:1
+46 ;Extract data
+47 DO GETS^DIQ(2,IENS,FIELDS,"",TARGET,MESSAGE)
+48 ;Accomodate for incorrect extraction of COUNTY (field #.117)
+49 ;S:(COUNTY) @TARGET@(2,IENS,.117)=$$COUNTY(DFN) ;**479
+50 ;Done
+51 QUIT
+52 ;
COUNTY(DFN) ;Return county name that patient lives in
+1 ;
+2 ;Input : DFN - Pointer to entry in PATIENT file (#2)
+3 ;Output : County - Name of county that patient lives in
+4 ;Notes : NULL is returned on error, bad input, and no county found
+5 ;
+6 ;Check input
+7 SET DFN=+$GET(DFN)
+8 ;Declare variables
+9 NEW IENS,PTRCNTY,PTRSTATE,TMP
+10 ;Get pointers to STATE file and COUNTY sub-file
+11 SET IENS=DFN_","
+12 DO GETS^DIQ(2,IENS,".115;.117","I","TMP","TMP")
+13 SET PTRSTATE=+$GET(TMP(2,IENS,.115,"I"))
+14 SET PTRCNTY=+$GET(TMP(2,IENS,.117,"I"))
+15 if (('PTRSTATE)!('PTRCNTY))
QUIT ""
+16 ;Get county name
+17 SET IENS=PTRCNTY_","_PTRSTATE_","
+18 DO GETS^DIQ(5.01,IENS,".01","","TMP","TMP")
+19 ;Return county name
+20 QUIT $GET(TMP(5.01,IENS,.01))
