| 1 | VAQUTL99 ;ALB/JFP,JRP - Various Function Calls;03FEB93
|
|---|
| 2 | ;;1.5;PATIENT DATA EXCHANGE;**2,10,29**;NOV 17, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | FUNCT ; *************** Function Calls ***************
|
|---|
| 5 | ;
|
|---|
| 6 | DASHSSN(SSN) ; -- Returns dash version of SSN
|
|---|
| 7 | ; INPUT : SSN - SSN without dashes
|
|---|
| 8 | ; OUTPUT : N - SSN with dashes
|
|---|
| 9 | Q:($G(SSN)="") ""
|
|---|
| 10 | Q:($E(SSN,10)'="P") $E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
|
|---|
| 11 | Q $E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)
|
|---|
| 12 | ;
|
|---|
| 13 | AGE(DOB) ; -- Returns age based on date of birth
|
|---|
| 14 | ; INPUT : X1 = DOB - INTERNAL FORMAT
|
|---|
| 15 | ; X2 - TODAYS DATE
|
|---|
| 16 | ; OUTPUT : AGE IN YEARS
|
|---|
| 17 | N X,X1,X2
|
|---|
| 18 | Q:($G(DOB)="") ""
|
|---|
| 19 | S X1=DT,X2=DOB
|
|---|
| 20 | D ^%DTC
|
|---|
| 21 | Q X\365.25
|
|---|
| 22 | ;
|
|---|
| 23 | DOBFMT(IDTE,STYLE) ; -- Returns formatted date
|
|---|
| 24 | ; INPUT : IDTE- INTERNAL FILEMAN DATE
|
|---|
| 25 | ; STYLE - FLAG INDICATING OUTPUT STYLE
|
|---|
| 26 | ; IF 0, OUTPUT IN MM-DD-YYYY FORMAT (DEFAULT)
|
|---|
| 27 | ; IF 1, OUTPUT IN MMM DD, YYYY FORMAT
|
|---|
| 28 | ; (MMM -> FIRST 3 CHARACTERS OF MONTH NAME)
|
|---|
| 29 | ; OUTPUT : EXTERNAL DATE IN SPECIFIED FORMAT
|
|---|
| 30 | S STYLE=+$G(STYLE)
|
|---|
| 31 | Q:($G(IDTE)="") ""
|
|---|
| 32 | ;MM-DD-YYYY
|
|---|
| 33 | Q:('STYLE) $E(IDTE,4,5)_"-"_$E(IDTE,6,7)_"-"_($E(IDTE,1,3)+1700)
|
|---|
| 34 | ;MMM DD, YYYY
|
|---|
| 35 | N Y,%DT
|
|---|
| 36 | S Y=$P(IDTE,".",1)
|
|---|
| 37 | D DD^%DT
|
|---|
| 38 | Q Y
|
|---|
| 39 | ;
|
|---|
| 40 | DATE(EDTE) ; -- Converts external date to internal date format
|
|---|
| 41 | ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
|
|---|
| 42 | ; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
|
|---|
| 43 | ; (TIME WILL BE RETURNED IF INCLUDED WITH INPUT)
|
|---|
| 44 | ;
|
|---|
| 45 | Q:'$D(EDTE) -1
|
|---|
| 46 | N X,%DT,Y
|
|---|
| 47 | S X=EDTE
|
|---|
| 48 | S %DT="TS"
|
|---|
| 49 | D ^%DT
|
|---|
| 50 | Q Y
|
|---|
| 51 | ;
|
|---|
| 52 | NOW(FMFORM,NOTIME) ;RETURNS CURRENT DATE & TIME
|
|---|
| 53 | ;INPUT : FMFORM - Flag indicating if FileMan format should be used
|
|---|
| 54 | ; If 0, return in the format MM-DD-YYYY@HH:MM:SS
|
|---|
| 55 | ; (default)
|
|---|
| 56 | ; If 1, return in FileMan format
|
|---|
| 57 | ; NOTIME - Flag indicating if time should not be included
|
|---|
| 58 | ; If 0, time will be included in output (default)
|
|---|
| 59 | ; If 1, time will not be included in output
|
|---|
| 60 | ;OUTPUT : Current date & time in specified format
|
|---|
| 61 | ;
|
|---|
| 62 | ;CHECK INPUT
|
|---|
| 63 | S FMFORM=+$G(FMFORM)
|
|---|
| 64 | S NOTIME=+$G(NOTIME)
|
|---|
| 65 | ;DECLARE VARIABLES
|
|---|
| 66 | N X,%,%H,%I,OUT
|
|---|
| 67 | S OUT="-1^Error occurred while determining current date and time"
|
|---|
| 68 | ;GET CURRENT DATE/TIME
|
|---|
| 69 | D NOW^%DTC
|
|---|
| 70 | ;FILEMAN FORMAT
|
|---|
| 71 | I (FMFORM) S OUT=$S(NOTIME:X,1:%)
|
|---|
| 72 | ;EXTERNAL FORMAT
|
|---|
| 73 | I ('FMFORM) D
|
|---|
| 74 | .S %=%_"000000"
|
|---|
| 75 | .S X=$E(%,4,5)_"-"_$E(%,6,7)_"-"_(1700+$E(%,1,3))_"@"_$E(%,9,10)_":"_$E(%,11,12)_":"_$E(%,13,14)
|
|---|
| 76 | .S OUT=$S(NOTIME:$P(X,"@",1),1:X)
|
|---|
| 77 | Q OUT
|
|---|
| 78 | ;
|
|---|
| 79 | RES(DOMAIN,SSN) ; -- Determines whether a request is manually or
|
|---|
| 80 | ; automatically processed and returns the reason
|
|---|
| 81 | ;
|
|---|
| 82 | ; INPUT : DOMAIN = E-mail address of facility
|
|---|
| 83 | ; SSN = requested name or SSN in internal
|
|---|
| 84 | ; format
|
|---|
| 85 | ;
|
|---|
| 86 | ; OUTPUT : 1^DFN = automatic process
|
|---|
| 87 | ; -N^Reason = manual process
|
|---|
| 88 | ; where
|
|---|
| 89 | ; -1 = bad input or no input, error
|
|---|
| 90 | ; -2 = patient not found
|
|---|
| 91 | ; -3 = ambiguous patient (not currently used)
|
|---|
| 92 | ; -4 = sensitive patient
|
|---|
| 93 | ; -5 = domain not in work group
|
|---|
| 94 | ;
|
|---|
| 95 | N SENPT,DFN,DOMDA
|
|---|
| 96 | Q:($G(SSN)="") "-1^Did not pass patient's name or SSN"
|
|---|
| 97 | Q:($G(DOMAIN)="") "-1^Did not pass remote domain"
|
|---|
| 98 | ;
|
|---|
| 99 | S DFN=$$GETDFN^VAQUTL97(SSN,1)
|
|---|
| 100 | Q:DFN=-1 "-2^Patient not found"
|
|---|
| 101 | ;
|
|---|
| 102 | S SENPT=$$GETSEN^VAQUTL97(+DFN)
|
|---|
| 103 | Q:SENPT=1 "-4^Sensitive patient"
|
|---|
| 104 | ;
|
|---|
| 105 | S DOMDA=+$$FIND1^DIC(4.2,"","BMX",DOMAIN,"B^C","","ERROR")
|
|---|
| 106 | Q:'$D(^VAT(394.82,"C",DOMDA)) "-5^Domain not in work group"
|
|---|
| 107 | ;
|
|---|
| 108 | Q ("1^"_(+DFN)) ; -- Automatic process
|
|---|
| 109 | ;
|
|---|
| 110 | DA(FLE,DNPT) ; -- Returns entry number in sub file (DA)
|
|---|
| 111 | ;
|
|---|
| 112 | ; INPUT : FLE = Sub file number
|
|---|
| 113 | ; DNPT = Pointer to patient in main file
|
|---|
| 114 | ;
|
|---|
| 115 | ; OUTPUT : DA = Entry number to sub file
|
|---|
| 116 | ; -1 = bad input or no input, error
|
|---|
| 117 | ;
|
|---|
| 118 | N MFLE,GLOBAL,NODE,SUBNO,ENTRY,ND
|
|---|
| 119 | Q:'$D(FLE) -1
|
|---|
| 120 | Q:'$D(DNPT) -1
|
|---|
| 121 | ;
|
|---|
| 122 | S MFLE=$G(^DD(FLE,0,"UP"))
|
|---|
| 123 | S MFLD="",MFLD=$O(^DD(MFLE,"SB",FLE,MFLD))
|
|---|
| 124 | S GLOBAL=$G(^DIC(MFLE,0,"GL"))
|
|---|
| 125 | S NODE=$G(^DD(MFLE,MFLD,0))
|
|---|
| 126 | S SUBNO=$P($P(NODE,U,4),";",1)
|
|---|
| 127 | S ND=GLOBAL_DNPT_","_SUBNO_",0)"
|
|---|
| 128 | S NODE=$G(@ND)
|
|---|
| 129 | S ENTRY=$P(NODE,U,4)
|
|---|
| 130 | Q ENTRY ; -- entry number in subfile
|
|---|
| 131 | ;
|
|---|
| 132 | END ; -- End of code
|
|---|
| 133 | QUIT
|
|---|
