| 1 | HDISVF01 ;BPFO/JRP - FILE UTILITIES/API;12/20/2004 ; 07 Mar 2005  9:53 AM
 | 
|---|
| 2 |  ;;1.0;HEALTH DATA & INFORMATICS;**1**;Feb 22, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;---- Begin HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 | GETSTAT(FILE,FIELD,DATE,FAC,DOMAIN,TYPE) ;Get file/field implementation status
 | 
|---|
| 7 |  ; Input : FILE - File number
 | 
|---|
| 8 |  ;         FIELD - Field number (defaults to .01)
 | 
|---|
| 9 |  ;         DATE - FileMan date/time to return status for (optional)
 | 
|---|
| 10 |  ;                (defaults to NOW)
 | 
|---|
| 11 |  ;         FAC - Facility number (optional) (defaults to current)
 | 
|---|
| 12 |  ;         DOMAIN - Domain/IP address (optional) (defaults to current)
 | 
|---|
| 13 |  ;         TYPE - Type of system (optional) (defaults to current)
 | 
|---|
| 14 |  ;                0 = Test     1 = Production
 | 
|---|
| 15 |  ;Output : StatusCode ^ StatusPointer ^ StatusDate
 | 
|---|
| 16 |  ; Notes : Values for "not started" status and no date are returned
 | 
|---|
| 17 |  ;         on bad input or if no entry is found
 | 
|---|
| 18 |  ;       : If time is not included with the date, the last status
 | 
|---|
| 19 |  ;         for the given day is returned
 | 
|---|
| 20 |  ;       : If more than one entry for the same date/time is found, the
 | 
|---|
| 21 |  ;         higher entry number is returned
 | 
|---|
| 22 |  N IEN,STATCODE,STATPTR,STATDT,NOTYET,FFPTR,SYSPTR,X
 | 
|---|
| 23 |  ;Calculate output for bad input
 | 
|---|
| 24 |  S STATCODE=0
 | 
|---|
| 25 |  S X=$$GETIEN^HDISVF06(STATCODE,+$$GETTYPE^HDISVF02(),.STATPTR)
 | 
|---|
| 26 |  S NOTYET=STATCODE_"^"_STATPTR_"^"
 | 
|---|
| 27 |  ;Check input
 | 
|---|
| 28 |  S FILE=+$G(FILE)
 | 
|---|
| 29 |  I 'FILE Q NOTYET
 | 
|---|
| 30 |  S FIELD=+$G(FIELD)
 | 
|---|
| 31 |  I 'FIELD S FIELD=.01
 | 
|---|
| 32 |  S DATE=+$G(DATE)
 | 
|---|
| 33 |  I 'DATE S DATE=$$NOW^XLFDT()
 | 
|---|
| 34 |  I '$P(DATE,".",2) S $P(DATE,".",2)=24
 | 
|---|
| 35 |  S FAC=+$G(FAC)
 | 
|---|
| 36 |  I 'FAC S FAC=$$FACNUM()
 | 
|---|
| 37 |  S DOMAIN=$G(DOMAIN)
 | 
|---|
| 38 |  I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME"))
 | 
|---|
| 39 |  S TYPE=$G(TYPE)
 | 
|---|
| 40 |  I TYPE="" S TYPE=$$PROD^XUPROD()
 | 
|---|
| 41 |  I ('FAC)!(DOMAIN="")!(TYPE="") Q NOTYET
 | 
|---|
| 42 |  ;Get pointers
 | 
|---|
| 43 |  I '$$FINDSYS^HDISVF07(DOMAIN,FAC,TYPE,1,.SYSPTR) Q NOTYET
 | 
|---|
| 44 |  I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q NOTYET
 | 
|---|
| 45 |  ;Get status date/time closest to input date/time
 | 
|---|
| 46 |  S DATE=DATE+.0000001
 | 
|---|
| 47 |  S STATDT=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,DATE),-1)
 | 
|---|
| 48 |  I 'STATDT Q NOTYET
 | 
|---|
| 49 |  ;Build list of entry numbers with found status date/time
 | 
|---|
| 50 |  K IEN
 | 
|---|
| 51 |  S STATPTR=0
 | 
|---|
| 52 |  F  S STATPTR=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR)) Q:'STATPTR  D
 | 
|---|
| 53 |  .S IEN=0
 | 
|---|
| 54 |  .F  S IEN=+$O(^HDISF(7118.25,"AFAC",SYSPTR,FFPTR,STATDT,STATPTR,IEN)) Q:'IEN  D
 | 
|---|
| 55 |  ..S IEN(IEN)=STATPTR
 | 
|---|
| 56 |  ;Get last entry number
 | 
|---|
| 57 |  S IEN=+$O(IEN(""),-1)
 | 
|---|
| 58 |  I 'IEN Q NOTYET
 | 
|---|
| 59 |  ;Build output
 | 
|---|
| 60 |  S STATPTR=IEN(IEN)
 | 
|---|
| 61 |  S X=$$GETCODE^HDISVF06(STATPTR,.STATCODE)
 | 
|---|
| 62 |  Q STATCODE_"^"_STATPTR_"^"_STATDT
 | 
|---|
| 63 |  ;
 | 
|---|
| 64 | SETSTAT(FILE,FIELD,CODE,DATE,STTYPE,FAC,DOMAIN,SYTYPE) ;Set file/field implementation status
 | 
|---|
| 65 |  ; Input : FILE - File number
 | 
|---|
| 66 |  ;         FIELD - Field number (defaults to .01)
 | 
|---|
| 67 |  ;         CODE - Status code to set (defaults to "not started")
 | 
|---|
| 68 |  ;         DATE - FileMan date/time to return status for (optional)
 | 
|---|
| 69 |  ;                (defaults to NOW)
 | 
|---|
| 70 |  ;         STTYPE - Type of status code being used (optional)
 | 
|---|
| 71 |  ;                  1 = Client (default)     2 = Server
 | 
|---|
| 72 |  ;         FAC - Facility number (optional) (defaults to current)
 | 
|---|
| 73 |  ;         DOMAIN - Domain/IP address (optional) (defaults to current)
 | 
|---|
| 74 |  ;         SYTYPE - Type of system (optional) (defaults to current)
 | 
|---|
| 75 |  ;                  0 = Test     1 = Production
 | 
|---|
| 76 |  ;Output : None
 | 
|---|
| 77 |  ; Notes : If time is not included with the date, 1 second past
 | 
|---|
| 78 |  ;         midnight will be used as the time
 | 
|---|
| 79 |  ;       : If an entry for the given file/field and date/time already
 | 
|---|
| 80 |  ;         exists, a new entry will still be added
 | 
|---|
| 81 |  N FFPTR,SYSPTR
 | 
|---|
| 82 |  ;Check input
 | 
|---|
| 83 |  S FILE=+$G(FILE)
 | 
|---|
| 84 |  I 'FILE Q
 | 
|---|
| 85 |  S FIELD=+$G(FIELD)
 | 
|---|
| 86 |  I 'FIELD S FIELD=.01
 | 
|---|
| 87 |  S CODE=+$G(CODE)
 | 
|---|
| 88 |  S DATE=+$G(DATE)
 | 
|---|
| 89 |  I 'DATE S DATE=$$NOW^XLFDT()
 | 
|---|
| 90 |  I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
 | 
|---|
| 91 |  S STTYPE=+$G(STTYPE)
 | 
|---|
| 92 |  I ('STTYPE)!(STTYPE<1)!(STTYPE>2) S STTYPE=1
 | 
|---|
| 93 |  S FAC=+$G(FAC)
 | 
|---|
| 94 |  I 'FAC S FAC=$$FACNUM()
 | 
|---|
| 95 |  S DOMAIN=$G(DOMAIN)
 | 
|---|
| 96 |  I DOMAIN="" S DOMAIN=$G(^XMB("NETNAME"))
 | 
|---|
| 97 |  S SYTYPE=$G(SYTYPE)
 | 
|---|
| 98 |  I SYTYPE="" S SYTYPE=$$PROD^XUPROD()
 | 
|---|
| 99 |  I ('FAC)!(DOMAIN="")!(SYTYPE="") Q
 | 
|---|
| 100 |  ;Get pointers
 | 
|---|
| 101 |  I '$$FINDSYS^HDISVF07(DOMAIN,FAC,SYTYPE,1,.SYSPTR) Q
 | 
|---|
| 102 |  I '$$GETIEN^HDISVF05(FILE,FIELD,.FFPTR) Q
 | 
|---|
| 103 |  ;Create entry
 | 
|---|
| 104 |  D ADDSTAT(FFPTR,SYSPTR,CODE,STTYPE,DATE)
 | 
|---|
| 105 |  Q
 | 
|---|
| 106 |  ;
 | 
|---|
| 107 | SCREEN(FILE,FIELD,DATE) ;Apply screening logic to file/field ?
 | 
|---|
| 108 |  ; Input : FILE - File number
 | 
|---|
| 109 |  ;         FIELD - Field number (defaults to .01)
 | 
|---|
| 110 |  ;         DATE - FileMan date/time to check against (optional)
 | 
|---|
| 111 |  ;                (defaults to NOW)
 | 
|---|
| 112 |  ;Output : Flag indicating if screening logic should be applied
 | 
|---|
| 113 |  ;         0 = Don't screen entries during selection
 | 
|---|
| 114 |  ;         1 = Screen entries during selection
 | 
|---|
| 115 |  ; Notes : 0 (don't screen) is returned on bad input
 | 
|---|
| 116 |  ;       : If time is not included with the date, the last status
 | 
|---|
| 117 |  ;         for the given day is returned
 | 
|---|
| 118 |  N SCREEN,STAT
 | 
|---|
| 119 |  S SCREEN=0
 | 
|---|
| 120 |  S FILE=+$G(FILE)
 | 
|---|
| 121 |  I 'FILE Q SCREEN
 | 
|---|
| 122 |  S FIELD=+$G(FIELD)
 | 
|---|
| 123 |  I 'FIELD S FIELD=.01
 | 
|---|
| 124 |  S DATE=+$G(DATE)
 | 
|---|
| 125 |  I 'DATE S DATE=$$NOW^XLFDT()
 | 
|---|
| 126 |  S STAT=$$GETSTAT(FILE,FIELD,DATE)
 | 
|---|
| 127 |  I +STAT=6 S SCREEN=1
 | 
|---|
| 128 |  Q SCREEN
 | 
|---|
| 129 |  ;
 | 
|---|
| 130 | ADDSTAT(FFPTR,SYSPTR,CODE,TYPE,DATE) ;Set file/field implementation status
 | 
|---|
| 131 |  ; Input : FFPTR - Pointer to HDIS FILE/FIELD file (#7115.6)
 | 
|---|
| 132 |  ;         SYSPTR - Pointer to HDIS SYSTEM file (#7118.21)
 | 
|---|
| 133 |  ;         CODE - Status code to set (defaults to "not started")
 | 
|---|
| 134 |  ;         TYPE - Type of status code being used (optional)
 | 
|---|
| 135 |  ;                1 = Client (default)     2 = Server
 | 
|---|
| 136 |  ;         DATE - FileMan date/time to return status for (optional)
 | 
|---|
| 137 |  ;                (defaults to NOW)
 | 
|---|
| 138 |  ;Ouput : None
 | 
|---|
| 139 |  ; Notes : If time is not included with the date, 1 second past
 | 
|---|
| 140 |  ;         midnight will be used as the time
 | 
|---|
| 141 |  ;       : If an entry for the given file/field and date/time already
 | 
|---|
| 142 |  ;         exists, a new entry will still be added
 | 
|---|
| 143 |  ;       : Call assumes that FFPTR and SYSPTR are valid
 | 
|---|
| 144 |  N STATPTR,HDISFDA,HDISIEN,HDISMSG,IENS
 | 
|---|
| 145 |  ;Check input
 | 
|---|
| 146 |  S FFPTR=+$G(FFPTR)
 | 
|---|
| 147 |  I 'FFPTR Q
 | 
|---|
| 148 |  S SYSPTR=+$G(SYSPTR)
 | 
|---|
| 149 |  I 'SYSPTR Q
 | 
|---|
| 150 |  S CODE=+$G(CODE)
 | 
|---|
| 151 |  S DATE=+$G(DATE)
 | 
|---|
| 152 |  I 'DATE S DATE=$$NOW^XLFDT()
 | 
|---|
| 153 |  I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
 | 
|---|
| 154 |  S TYPE=+$G(TYPE)
 | 
|---|
| 155 |  I ('TYPE)!(TYPE<1)!(TYPE>2) S TYPE=1
 | 
|---|
| 156 |  ;Get pointer to status
 | 
|---|
| 157 |  I '$$GETIEN^HDISVF06(CODE,TYPE,.STATPTR) Q
 | 
|---|
| 158 |  ;Create entry
 | 
|---|
| 159 |  S IENS="+1,"
 | 
|---|
| 160 |  S HDISFDA(7118.25,IENS,.01)=SYSPTR
 | 
|---|
| 161 |  S HDISFDA(7118.25,IENS,.02)=FFPTR
 | 
|---|
| 162 |  S HDISFDA(7118.25,IENS,.03)=STATPTR
 | 
|---|
| 163 |  S HDISFDA(7118.25,IENS,.04)=DATE
 | 
|---|
| 164 |  D UPDATE^DIE("","HDISFDA","HDISIEN","HDISMSG")
 | 
|---|
| 165 |  Q
 | 
|---|
| 166 |  ;
 | 
|---|
| 167 |  ;---- End HDIS VUID IMPLEMENTATION STATUS file (#7118.25) APIs ----
 | 
|---|
| 168 |  ;
 | 
|---|
| 169 | FACPTR(FACNUM) ;Return pointer to INSTITUTION file (#4) for facility number
 | 
|---|
| 170 |  ; Input : FACNUM - Facility number (optional) (defaults to current)
 | 
|---|
| 171 |  ;Output : Pointer to INSTITUTION file (#4)
 | 
|---|
| 172 |  ; Notes : NULL ("") is returned if an entry can not be found
 | 
|---|
| 173 |  N FACPTR
 | 
|---|
| 174 |  S FACNUM=$G(FACNUM)
 | 
|---|
| 175 |  I 'FACNUM D  Q FACPTR
 | 
|---|
| 176 |  .S FACPTR=+$$SITE^VASITE()
 | 
|---|
| 177 |  .I FACPTR<1 S FACPTR=""
 | 
|---|
| 178 |  S FACPTR=$$LKUP^XUAF4(FACNUM)
 | 
|---|
| 179 |  I 'FACPTR S FACPTR=""
 | 
|---|
| 180 |  Q FACPTR
 | 
|---|
| 181 |  ;
 | 
|---|
| 182 | FACNUM(FACPTR) ;Return facility number
 | 
|---|
| 183 |  ; Input : FACPTR - Pointer to INSTITUTION file (#4) (optional)
 | 
|---|
| 184 |  ;                  (default to current location)
 | 
|---|
| 185 |  ;Output : Facility number
 | 
|---|
| 186 |  ;         Null ("") returned if facility number couldn't be determined
 | 
|---|
| 187 |  N FACNUM
 | 
|---|
| 188 |  S FACPTR=$G(FACPTR)
 | 
|---|
| 189 |  I 'FACPTR D  Q FACNUM
 | 
|---|
| 190 |  .S FACNUM=$P($$SITE^VASITE(),"^",3)
 | 
|---|
| 191 |  .I FACNUM<1 S FACNUM=""
 | 
|---|
| 192 |  S FACNUM=$P($$NS^XUAF4(FACPTR),"^",2)
 | 
|---|
| 193 |  I FACNUM<1 S FACNUM=""
 | 
|---|
| 194 |  Q FACNUM
 | 
|---|