RORX002 ;HOIFO/SG,VAC - CURRENT INPATIENT LIST ;4/7/09 2:06pm
;;1.5;CLINICAL CASE REGISTRIES;**1,8,19,21,31,32,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #10061 51^VADPT (supported)
;
; Routine modified March 2009 for ICD9 filter for INCLUDE or EXCLUDE
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*32 11/07/17 S ALSAHHAR Add 'Admitting Diagnosis' column
;ROR*1.5*34 09/24/18 F TRAXLER Add 'Admitting Date' column
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
;;PATIENTS(#,NAME,LAST4,AGE,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;
N HEADER,RC
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX002",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** COMPILES THE "CURRENT INPATIENT LIST"
; REPORT CODE: 002
;
; .RORTSK Task number and task parameters
;
; Return Values:
; <0 Error code
; 0 Ok
;
INPTLST(RORTSK) ;
N RORPTN ; Number of patients in the registry
N RORREG ; Registry IEN
N RORTMP ; Closed root of the temporary buffer
;
N BODY,ECNT,INPCNT,RC,REPORT,SFLAGS,TMP
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get and prepare the report parameters
S RORREG=$$PARAM^RORTSK01("REGIEN")
S RC=$$PARAMS^RORXU002(.RORTSK,REPORT,,,.SFLAGS) Q:RC<0 RC
;
;--- Initialize constants and variables
S ECNT=0
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
;
;--- Report header
S RC=$$HEADER(REPORT) Q:RC<0 RC
S RORTMP=$$ALLOC^RORTMP()
D
. ;--- Query the registry
. D TPPSETUP^RORTSK01(50)
. S RC=$$QUERY(.INPCNT,SFLAGS)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Generate the list of patients
. D TPPSETUP^RORTSK01(50)
. S RC=$$PTLIST(REPORT,INPCNT)
. I RC Q:RC<0 S ECNT=ECNT+RC
;
;--- Cleanup
D FREE^RORTMP(RORTMP)
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;***** ADDS THE PATIENT DATA TO THE REPORT
;
; NODE Closed root of the patient's node in the buffer
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
PATIENT(NODE,PARTAG) ;
N IEN,NAME,PATIEN,PTAG,PTBUF,RC,TMP,AGETYPE
S PTBUF=@NODE,PATIEN=$P(PTBUF,U,2)
Q:PATIEN'>0 0
;--- The <PATIENT> tag
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,PATIEN)
;--- Patient data
D ADDVAL^RORTSK11(RORTSK,"NAME",$QS(NODE,4),PTAG,1)
D ADDVAL^RORTSK11(RORTSK,"LAST4",$QS(NODE,5),PTAG,2)
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. D ADDVAL^RORTSK11(RORTSK,$S(AGETYPE="AGE":"AGE",1:"DOB"),$P(PTBUF,U,8),PTAG,1)
S TMP=$$DATE^RORXU002($P(PTBUF,U,4)\1)
;D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
;
D ADDVAL^RORTSK11(RORTSK,"WARD",$QS(NODE,3),PTAG,1)
D ADDVAL^RORTSK11(RORTSK,"ROOM-BED",$P(PTBUF,U,3),PTAG,1)
D ADDVAL^RORTSK11(RORTSK,"ADMDT",$P(PTBUF,U,10),PTAG,1) ;patch 34
D ADDVAL^RORTSK11(RORTSK,"DIAG",$P(PTBUF,U,9),PTAG,1)
; --- ICN, PACT, PCP if selected will be one of the last columns on report accordingly.
I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(PTBUF,U,5),PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(PTBUF,U,6),PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(PTBUF,U,7),PTAG,1)
Q 0
;
;***** GENERATES THE LIST OF PATIENTS
;
; REPORT IEN of the <REPORT> node
; INPCNT Number of inpatients
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
PTLIST(REPORT,INPCNT) ;
N BODY,CNT,ECNT,FLT,FLTLEN,NODE,RC,TCNT,TMP
S (CNT,ECNT,RC)=0
S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
Q:BODY<0 BODY
D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
D:$D(@RORTMP)>1
. S $P(NODE,U,5)="0000"
. S NODE=RORTMP
. S FLTLEN=$L(NODE)-1,FLT=$E(NODE,1,FLTLEN)
. F S NODE=$Q(@NODE) Q:$E(NODE,1,FLTLEN)'=FLT D Q:RC<0
. . S TMP=$S(INPCNT>0:CNT/INPCNT,1:"")
. . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. . S CNT=CNT+1
. . I $$PATIENT(NODE,BODY)<0 S ECNT=ECNT+1 Q
Q $S(RC<0:RC,1:ECNT)
;
;***** QUERIES THE REGISTRY
;
; .INPCNT Number of inpatients is returned in this parameter
; SFLAGS Flags for $$SKIP^RORXU005
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(INPCNT,SFLAGS) ;
N CNT,DFN,ECNT,IEN,IENS,RC,TCNT,TMP,VA,VADM,VAHOW,VAIP,VAROOT,XREFNODE,WARD,AGEDOB
N RCC,FLAG
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S (CNT,ECNT,INPCNT,RC)=0
;--- Browse through the registry records
S IEN=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S IENS=IEN_",",CNT=CNT+1
. ;--- Skip a patient
. Q:$$SKIP^RORXU005(IEN,SFLAGS)
. ;--- Process the registry record
. S DFN=$$PTIEN^RORUTL01(IEN) Q:DFN'>0
.; --- Check the ICD filter
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(DFN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
.;--- End of ICD Filter check
. K VA,VADM,VAIP,VAIN S VAIP("D")=DT\1 D 51^VADPT
. D INP^VADPT
. S AGEDOB=$$PARAM^RORTSK01("AGE_RANGE","TYPE") S AGEDOB=$S(AGEDOB="AGE":$P($G(VADM(4)),U),AGEDOB="DOB":$P($G(VADM(3)),U),1:"")
. S WARD=$P(VAIP(5),U,2) Q:WARD=""
. S VA("BID")="0000" S TMP=$S($G(VA("BID"))'="":VA("BID"),1:"UNKN") ; Last 4 of SSN
. S @RORTMP@(WARD,VADM(1),TMP)=IEN_U_DFN_U_$P(VAIP(6),U,2)_U_$P(VADM(6),U)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$ICN^RORUTL02(DFN)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$PACT^RORUTL02(DFN)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$PCP^RORUTL02(DFN)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$DATE^RORXU002(AGEDOB\1)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_VAIN(9)
. S @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$P($P($G(VAIN(7)),U,1),".",1) ;adm date patch 34
. S INPCNT=INPCNT+1
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** CHECKS THE SUFFIX FOR VALIDITY
;
; SUFFIX Suffix
;
; Return Values:
; 0 Ok
; 1 Invalid suffix
VSUFFIX(SUFFIX) ;
Q '("9AA,9AB,9BB,A0,A4,A5,BU,BV,PA"[SUFFIX)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX002 7648 printed Apr 09, 2024@20:46:41 Page 2
RORX002 ;HOIFO/SG,VAC - CURRENT INPATIENT LIST ;4/7/09 2:06pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,8,19,21,31,32,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10061 51^VADPT (supported)
+6 ;
+7 ; Routine modified March 2009 for ICD9 filter for INCLUDE or EXCLUDE
+8 ;
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+16 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+17 ; requested.
+18 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+19 ; identifiers.
+20 ;ROR*1.5*32 11/07/17 S ALSAHHAR Add 'Admitting Diagnosis' column
+21 ;ROR*1.5*34 09/24/18 F TRAXLER Add 'Admitting Date' column
+22 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+23 ;******************************************************************************
+24 ;
+25 QUIT
+26 ;
+27 ;***** OUTPUTS THE REPORT HEADER
+28 ;
+29 ; PARTAG Reference (IEN) to the parent tag
+30 ;
+31 ; Return Values:
+32 ; <0 Error code
+33 ; 0 Ok
+34 ;
+1 ;;PATIENTS(#,NAME,LAST4,AGE,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+2 ;;PATIENTS(#,NAME,LAST4,DOB,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+3 ;;PATIENTS(#,NAME,LAST4,WARD,ROOM-BED,ADMDT,DIAG,ICN,PACT,PCP)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+4 ;
+5 NEW HEADER,RC
+6 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+7 if HEADER<0
QUIT HEADER
+8 SET RC=$$TBLDEF^RORXU002("HEADER^RORX002",HEADER)
+9 QUIT $SELECT(RC<0:RC,1:HEADER)
+10 ;
+11 ;***** COMPILES THE "CURRENT INPATIENT LIST"
+12 ; REPORT CODE: 002
+13 ;
+14 ; .RORTSK Task number and task parameters
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ;
INPTLST(RORTSK) ;
+1 ; Number of patients in the registry
NEW RORPTN
+2 ; Registry IEN
NEW RORREG
+3 ; Closed root of the temporary buffer
NEW RORTMP
+4 ;
+5 NEW BODY,ECNT,INPCNT,RC,REPORT,SFLAGS,TMP
+6 ;--- Root node of the report
+7 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+8 if REPORT<0
QUIT REPORT
+9 ;
+10 ;--- Get and prepare the report parameters
+11 SET RORREG=$$PARAM^RORTSK01("REGIEN")
+12 SET RC=$$PARAMS^RORXU002(.RORTSK,REPORT,,,.SFLAGS)
if RC<0
QUIT RC
+13 ;
+14 ;--- Initialize constants and variables
+15 SET ECNT=0
+16 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+17 ;
+18 ;--- Report header
+19 SET RC=$$HEADER(REPORT)
if RC<0
QUIT RC
+20 SET RORTMP=$$ALLOC^RORTMP()
+21 Begin DoDot:1
+22 ;--- Query the registry
+23 DO TPPSETUP^RORTSK01(50)
+24 SET RC=$$QUERY(.INPCNT,SFLAGS)
+25 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+26 ;--- Generate the list of patients
+27 DO TPPSETUP^RORTSK01(50)
+28 SET RC=$$PTLIST(REPORT,INPCNT)
+29 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
+30 ;
+31 ;--- Cleanup
+32 DO FREE^RORTMP(RORTMP)
+33 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+34 ;
+35 ;***** ADDS THE PATIENT DATA TO THE REPORT
+36 ;
+37 ; NODE Closed root of the patient's node in the buffer
+38 ; PARTAG Reference (IEN) to the parent tag
+39 ;
+40 ; Return Values:
+41 ; <0 Error code
+42 ; 0 Ok
+43 ;
PATIENT(NODE,PARTAG) ;
+1 NEW IEN,NAME,PATIEN,PTAG,PTBUF,RC,TMP,AGETYPE
+2 SET PTBUF=@NODE
SET PATIEN=$PIECE(PTBUF,U,2)
+3 if PATIEN'>0
QUIT 0
+4 ;--- The <PATIENT> tag
+5 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,PATIEN)
+6 ;--- Patient data
+7 DO ADDVAL^RORTSK11(RORTSK,"NAME",$QSUBSCRIPT(NODE,4),PTAG,1)
+8 DO ADDVAL^RORTSK11(RORTSK,"LAST4",$QSUBSCRIPT(NODE,5),PTAG,2)
+9 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:1
+10 DO ADDVAL^RORTSK11(RORTSK,$SELECT(AGETYPE="AGE":"AGE",1:"DOB"),$PIECE(PTBUF,U,8),PTAG,1)
End DoDot:1
+11 SET TMP=$$DATE^RORXU002($PIECE(PTBUF,U,4)\1)
+12 ;D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
+13 ;
+14 DO ADDVAL^RORTSK11(RORTSK,"WARD",$QSUBSCRIPT(NODE,3),PTAG,1)
+15 DO ADDVAL^RORTSK11(RORTSK,"ROOM-BED",$PIECE(PTBUF,U,3),PTAG,1)
+16 ;patch 34
DO ADDVAL^RORTSK11(RORTSK,"ADMDT",$PIECE(PTBUF,U,10),PTAG,1)
+17 DO ADDVAL^RORTSK11(RORTSK,"DIAG",$PIECE(PTBUF,U,9),PTAG,1)
+18 ; --- ICN, PACT, PCP if selected will be one of the last columns on report accordingly.
+19 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(PTBUF,U,5),PTAG,1)
+20 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(PTBUF,U,6),PTAG,1)
+21 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(PTBUF,U,7),PTAG,1)
+22 QUIT 0
+23 ;
+24 ;***** GENERATES THE LIST OF PATIENTS
+25 ;
+26 ; REPORT IEN of the <REPORT> node
+27 ; INPCNT Number of inpatients
+28 ;
+29 ; Return Values:
+30 ; <0 Error code
+31 ; 0 Ok
+32 ; >0 Number of non-fatal errors
+33 ;
PTLIST(REPORT,INPCNT) ;
+1 NEW BODY,CNT,ECNT,FLT,FLTLEN,NODE,RC,TCNT,TMP
+2 SET (CNT,ECNT,RC)=0
+3 SET BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+4 if BODY<0
QUIT BODY
+5 DO ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
+6 if $DATA(@RORTMP)>1
Begin DoDot:1
+7 SET $PIECE(NODE,U,5)="0000"
+8 SET NODE=RORTMP
+9 SET FLTLEN=$LENGTH(NODE)-1
SET FLT=$EXTRACT(NODE,1,FLTLEN)
+10 FOR
SET NODE=$QUERY(@NODE)
if $EXTRACT(NODE,1,FLTLEN)'=FLT
QUIT
Begin DoDot:2
+11 SET TMP=$SELECT(INPCNT>0:CNT/INPCNT,1:"")
+12 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+13 SET CNT=CNT+1
+14 IF $$PATIENT(NODE,BODY)<0
SET ECNT=ECNT+1
QUIT
End DoDot:2
if RC<0
QUIT
End DoDot:1
+15 QUIT $SELECT(RC<0:RC,1:ECNT)
+16 ;
+17 ;***** QUERIES THE REGISTRY
+18 ;
+19 ; .INPCNT Number of inpatients is returned in this parameter
+20 ; SFLAGS Flags for $$SKIP^RORXU005
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; 0 Ok
+25 ; >0 Number of non-fatal errors
+26 ;
QUERY(INPCNT,SFLAGS) ;
+1 NEW CNT,DFN,ECNT,IEN,IENS,RC,TCNT,TMP,VA,VADM,VAHOW,VAIP,VAROOT,XREFNODE,WARD,AGEDOB
+2 NEW RCC,FLAG
+3 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+4 SET (CNT,ECNT,INPCNT,RC)=0
+5 ;--- Browse through the registry records
+6 SET IEN=0
+7 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+8 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+10 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+11 SET IENS=IEN_","
SET CNT=CNT+1
+12 ;--- Skip a patient
+13 if $$SKIP^RORXU005(IEN,SFLAGS)
QUIT
+14 ;--- Process the registry record
+15 SET DFN=$$PTIEN^RORUTL01(IEN)
if DFN'>0
QUIT
+16 ; --- Check the ICD filter
+17 SET RCC=0
+18 IF FLAG'="ALL"
Begin DoDot:2
+19 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:2
+20 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+21 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+22 ;--- End of ICD Filter check
+23 KILL VA,VADM,VAIP,VAIN
SET VAIP("D")=DT\1
DO 51^VADPT
+24 DO INP^VADPT
+25 SET AGEDOB=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
SET AGEDOB=$SELECT(AGEDOB="AGE":$PIECE($GET(VADM(4)),U),AGEDOB="DOB":$PIECE($GET(VADM(3)),U),1:"")
+26 SET WARD=$PIECE(VAIP(5),U,2)
if WARD=""
QUIT
+27 ; Last 4 of SSN
SET VA("BID")="0000"
SET TMP=$SELECT($GET(VA("BID"))'="":VA("BID"),1:"UNKN")
+28 SET @RORTMP@(WARD,VADM(1),TMP)=IEN_U_DFN_U_$PIECE(VAIP(6),U,2)_U_$PIECE(VADM(6),U)
+29 SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$ICN^RORUTL02(DFN)
+30 SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$PACT^RORUTL02(DFN)
+31 SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$PCP^RORUTL02(DFN)
+32 SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$$DATE^RORXU002(AGEDOB\1)
+33 SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_VAIN(9)
+34 ;adm date patch 34
SET @RORTMP@(WARD,VADM(1),TMP)=@RORTMP@(WARD,VADM(1),TMP)_U_$PIECE($PIECE($GET(VAIN(7)),U,1),".",1)
+35 SET INPCNT=INPCNT+1
End DoDot:1
if RC<0
QUIT
+36 ;---
+37 QUIT $SELECT(RC<0:RC,1:ECNT)
+38 ;
+39 ;***** CHECKS THE SUFFIX FOR VALIDITY
+40 ;
+41 ; SUFFIX Suffix
+42 ;
+43 ; Return Values:
+44 ; 0 Ok
+45 ; 1 Invalid suffix
VSUFFIX(SUFFIX) ;
+1 QUIT '("9AA,9AB,9BB,A0,A4,A5,BU,BV,PA"[SUFFIX)
