VIAANPR ;ALB/WW - New Person / Employee RPCs for RTLS ;4/20/16 10:09 pm
;;1.0;RTLS;**4**;April 22, 2013;Build 21
;;
;; RTLS New Person / Employee RPC calls
Q
;
; Reference to ^VA(200 supported by IA #10060
;
;----------------------------------------------------------------------------
RTLSNP(RETSTA,REQDATA,DATAID) ; Retrieve Employee Information.
;
; This RPC allows retrieval of the following fields from
; the New Person File (#200):
; IEN
; NAME ( #.01)
; DIVISION (#16)
; SEX (#4)
; DOB (#5)
; TITLE (#8)
; SERVICE/SECTION (#29)
;
; Input:
; RETSTA - name of the return array
; REQDATA - identifies the type of data that is being requested:
; "IEN" defines DATAID as a Social Security Number
; "NAME" defines DATAID as a Name/Partial Name
; DATAID - identifies which data is to be returned for REQDATA:
; IEN if REQDATA="IEN"
; NAME/PARTIAL NAME if REQDATA="NAME"
; Output:
; Global ^TMP("VIAA"_REQDATA,$J,n)
; Contains data elements when REQDATA and DATAID are passed in as
; input parameters and are defined as follows:
; "IEN^FIRSTNAME^LASTNAME^MIDDLENAME^DIVISION^SEX^DOB^TITLE...
; ...^SERVICE/SECTION^NETWORK USERNAME"
; or an error condition:
; "-###^" concatenated with reason for failure is returned,
; where '###' is a 3-digit code
;
N TMP,TVIAA,VIAA,VIAACNT,VIAAIEN,VIAAOUT
;
S VIAA="VIAA"_REQDATA
;
K ^TMP(VIAA,$J)
;
I $G(REQDATA)="" S ^TMP(VIAA,$J,0)="-400^REQDATA must be the keyword 'IEN' or 'NAME'" D OUTPUT Q
;
I $G(DATAID)="" D Q
.I $G(REQDATA)="NAME" S ^TMP(VIAA,$J,0)="-400^Name cannot be null" D OUTPUT
.I $G(REQDATA)="IEN" S ^TMP(VIAA,$J,0)="-400^IEN cannot be null" D OUTPUT
I "^IEN^NAME^"'[(U_REQDATA_U) D Q
.S ^TMP(VIAA,$J,0)="-400^REQDATA must be the keyword 'IEN' or 'NAME'"
.D OUTPUT
;
I REQDATA="IEN" D Q
.I '$D(^VA(200,DATAID)) D D OUTPUT Q
..S ^TMP(VIAA,$J,0)="-400^("_DATAID_") not a recognized IEN"
.S VIAAIEN=DATAID
.D BUILD(0),OUTPUT
;
;I DATAID="*" D D OUTPUT Q
;.S TMP="",VIAACNT=-1
;.F S TMP=$O(^VA(200,"B",TMP)) Q:TMP="" D
;..S VIAAIEN=$O(^VA(200,"B",TMP,""))
;..I VIAAIEN]"" S VIAACNT=VIAACNT+1 D BUILD(VIAACNT)
;
I $E(DATAID,1)="'" S DATAID=$E(DATAID,2,$L(DATAID))
I $E(DATAID,$L(DATAID))="'" S DATAID=$E(DATAID,1,($L(DATAID)-1))
;
D FIND^DIC(200,,,"B",DATAID,,,,,"VIAAOUT")
;
I '$D(VIAAOUT("DILIST",2)) D Q
.S ^TMP(VIAA,$J,0)="-404^no name match found for ("_DATAID_")"
.D OUTPUT
;
S TVIAA="" F VIAACNT=0:1 S TVIAA=$O(VIAAOUT("DILIST",2,TVIAA)) Q:TVIAA="" D
.S VIAAIEN=VIAAOUT("DILIST",2,TVIAA)
.D BUILD(VIAACNT)
;
D OUTPUT
;
Q
;----------------------------------------------------------------------------
BUILD(VIAACNT) ; Build the ^TMP output entries.
;
N TMP,VIAADIV,VIAADOB,VIAANAME,VIAATMP
;
S (VIAATMP,VIAADIV)=""
I $P($G(^VA(200,VIAAIEN,2,0)),U,3)'="" D
.F S VIAATMP=$O(^VA(200,VIAAIEN,2,"B",VIAATMP)) Q:VIAATMP="" D
..S VIAADIV=$$GET1^DIQ(200.02,VIAATMP_","_VIAAIEN_",",.01,"I")
;
S VIAADOB=$$GET1^DIQ(200,VIAAIEN_",","DOB")
I VIAADOB]"" D
.D DT^DILF("TS",VIAADOB,.VIAADOB)
.I VIAADOB]"" D
..S VIAADOB=$E(VIAADOB,4,5)_"/"_$E(VIAADOB,6,7)_"/"_$E((1700+$E(VIAADOB,1,3)),1,4)
;
S TMP=$$GET1^DIQ(200,VIAAIEN_",","NAME")
S VIAANAME=$P(TMP,",")_U_$P($P(TMP,",",2)," ")_U_$P($P(TMP,",",2)," ",2,3)
;
S VIAATMP=VIAAIEN_U_VIAANAME
S VIAATMP=VIAATMP_U_$S(VIAADIV]"":VIAADIV,1:$$STA^XUAF4($$KSP^XUPARAM("INST")))
S VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","SEX","I")
S VIAATMP=VIAATMP_U_VIAADOB
S VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","TITLE")
S VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","SERVICE/SECTION")
S VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","NETWORK USERNAME")
S ^TMP(VIAA,$J,VIAACNT)=VIAATMP
;
Q
;----------------------------------------------------------------------------
OUTPUT ; Move the ^TMP data to the output array RETSTA
;
M RETSTA=^TMP(VIAA,$J)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVIAANPR 4046 printed Nov 22, 2024@17:43:16 Page 2
VIAANPR ;ALB/WW - New Person / Employee RPCs for RTLS ;4/20/16 10:09 pm
+1 ;;1.0;RTLS;**4**;April 22, 2013;Build 21
+2 ;;
+3 ;; RTLS New Person / Employee RPC calls
+4 QUIT
+5 ;
+6 ; Reference to ^VA(200 supported by IA #10060
+7 ;
+8 ;----------------------------------------------------------------------------
RTLSNP(RETSTA,REQDATA,DATAID) ; Retrieve Employee Information.
+1 ;
+2 ; This RPC allows retrieval of the following fields from
+3 ; the New Person File (#200):
+4 ; IEN
+5 ; NAME ( #.01)
+6 ; DIVISION (#16)
+7 ; SEX (#4)
+8 ; DOB (#5)
+9 ; TITLE (#8)
+10 ; SERVICE/SECTION (#29)
+11 ;
+12 ; Input:
+13 ; RETSTA - name of the return array
+14 ; REQDATA - identifies the type of data that is being requested:
+15 ; "IEN" defines DATAID as a Social Security Number
+16 ; "NAME" defines DATAID as a Name/Partial Name
+17 ; DATAID - identifies which data is to be returned for REQDATA:
+18 ; IEN if REQDATA="IEN"
+19 ; NAME/PARTIAL NAME if REQDATA="NAME"
+20 ; Output:
+21 ; Global ^TMP("VIAA"_REQDATA,$J,n)
+22 ; Contains data elements when REQDATA and DATAID are passed in as
+23 ; input parameters and are defined as follows:
+24 ; "IEN^FIRSTNAME^LASTNAME^MIDDLENAME^DIVISION^SEX^DOB^TITLE...
+25 ; ...^SERVICE/SECTION^NETWORK USERNAME"
+26 ; or an error condition:
+27 ; "-###^" concatenated with reason for failure is returned,
+28 ; where '###' is a 3-digit code
+29 ;
+30 NEW TMP,TVIAA,VIAA,VIAACNT,VIAAIEN,VIAAOUT
+31 ;
+32 SET VIAA="VIAA"_REQDATA
+33 ;
+34 KILL ^TMP(VIAA,$JOB)
+35 ;
+36 IF $GET(REQDATA)=""
SET ^TMP(VIAA,$JOB,0)="-400^REQDATA must be the keyword 'IEN' or 'NAME'"
DO OUTPUT
QUIT
+37 ;
+38 IF $GET(DATAID)=""
Begin DoDot:1
+39 IF $GET(REQDATA)="NAME"
SET ^TMP(VIAA,$JOB,0)="-400^Name cannot be null"
DO OUTPUT
+40 IF $GET(REQDATA)="IEN"
SET ^TMP(VIAA,$JOB,0)="-400^IEN cannot be null"
DO OUTPUT
End DoDot:1
QUIT
+41 IF "^IEN^NAME^"'[(U_REQDATA_U)
Begin DoDot:1
+42 SET ^TMP(VIAA,$JOB,0)="-400^REQDATA must be the keyword 'IEN' or 'NAME'"
+43 DO OUTPUT
End DoDot:1
QUIT
+44 ;
+45 IF REQDATA="IEN"
Begin DoDot:1
+46 IF '$DATA(^VA(200,DATAID))
Begin DoDot:2
+47 SET ^TMP(VIAA,$JOB,0)="-400^("_DATAID_") not a recognized IEN"
End DoDot:2
DO OUTPUT
QUIT
+48 SET VIAAIEN=DATAID
+49 DO BUILD(0)
DO OUTPUT
End DoDot:1
QUIT
+50 ;
+51 ;I DATAID="*" D D OUTPUT Q
+52 ;.S TMP="",VIAACNT=-1
+53 ;.F S TMP=$O(^VA(200,"B",TMP)) Q:TMP="" D
+54 ;..S VIAAIEN=$O(^VA(200,"B",TMP,""))
+55 ;..I VIAAIEN]"" S VIAACNT=VIAACNT+1 D BUILD(VIAACNT)
+56 ;
+57 IF $EXTRACT(DATAID,1)="'"
SET DATAID=$EXTRACT(DATAID,2,$LENGTH(DATAID))
+58 IF $EXTRACT(DATAID,$LENGTH(DATAID))="'"
SET DATAID=$EXTRACT(DATAID,1,($LENGTH(DATAID)-1))
+59 ;
+60 DO FIND^DIC(200,,,"B",DATAID,,,,,"VIAAOUT")
+61 ;
+62 IF '$DATA(VIAAOUT("DILIST",2))
Begin DoDot:1
+63 SET ^TMP(VIAA,$JOB,0)="-404^no name match found for ("_DATAID_")"
+64 DO OUTPUT
End DoDot:1
QUIT
+65 ;
+66 SET TVIAA=""
FOR VIAACNT=0:1
SET TVIAA=$ORDER(VIAAOUT("DILIST",2,TVIAA))
if TVIAA=""
QUIT
Begin DoDot:1
+67 SET VIAAIEN=VIAAOUT("DILIST",2,TVIAA)
+68 DO BUILD(VIAACNT)
End DoDot:1
+69 ;
+70 DO OUTPUT
+71 ;
+72 QUIT
+73 ;----------------------------------------------------------------------------
BUILD(VIAACNT) ; Build the ^TMP output entries.
+1 ;
+2 NEW TMP,VIAADIV,VIAADOB,VIAANAME,VIAATMP
+3 ;
+4 SET (VIAATMP,VIAADIV)=""
+5 IF $PIECE($GET(^VA(200,VIAAIEN,2,0)),U,3)'=""
Begin DoDot:1
+6 FOR
SET VIAATMP=$ORDER(^VA(200,VIAAIEN,2,"B",VIAATMP))
if VIAATMP=""
QUIT
Begin DoDot:2
+7 SET VIAADIV=$$GET1^DIQ(200.02,VIAATMP_","_VIAAIEN_",",.01,"I")
End DoDot:2
End DoDot:1
+8 ;
+9 SET VIAADOB=$$GET1^DIQ(200,VIAAIEN_",","DOB")
+10 IF VIAADOB]""
Begin DoDot:1
+11 DO DT^DILF("TS",VIAADOB,.VIAADOB)
+12 IF VIAADOB]""
Begin DoDot:2
+13 SET VIAADOB=$EXTRACT(VIAADOB,4,5)_"/"_$EXTRACT(VIAADOB,6,7)_"/"_$EXTRACT((1700+$EXTRACT(VIAADOB,1,3)),1,4)
End DoDot:2
End DoDot:1
+14 ;
+15 SET TMP=$$GET1^DIQ(200,VIAAIEN_",","NAME")
+16 SET VIAANAME=$PIECE(TMP,",")_U_$PIECE($PIECE(TMP,",",2)," ")_U_$PIECE($PIECE(TMP,",",2)," ",2,3)
+17 ;
+18 SET VIAATMP=VIAAIEN_U_VIAANAME
+19 SET VIAATMP=VIAATMP_U_$SELECT(VIAADIV]"":VIAADIV,1:$$STA^XUAF4($$KSP^XUPARAM("INST")))
+20 SET VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","SEX","I")
+21 SET VIAATMP=VIAATMP_U_VIAADOB
+22 SET VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","TITLE")
+23 SET VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","SERVICE/SECTION")
+24 SET VIAATMP=VIAATMP_U_$$GET1^DIQ(200,VIAAIEN_",","NETWORK USERNAME")
+25 SET ^TMP(VIAA,$JOB,VIAACNT)=VIAATMP
+26 ;
+27 QUIT
+28 ;----------------------------------------------------------------------------
OUTPUT ; Move the ^TMP data to the output array RETSTA
+1 ;
+2 MERGE RETSTA=^TMP(VIAA,$JOB)
+3 ;
+4 QUIT
