DGRRPSAD ; ALB/SGG - rtnDGRR PatientServices ADT Information ;09/30/03 ; Compiled December 9, 2003 15:22:22
;;5.3;Registration;**557**;Aug 13, 1993
;
DOC ;<DataSet Name='ADT'
;
;.102 CURRENT MOVEMENT (*P405'), [.102;1]
; FILE (#405) PATIENT MOVEMENT STORED IN: ^DGPM(
; .01 DATE/TIME (RDX), [0;1]
;
;.1 WARD LOCATION (FX), [.1;E1,30]
;.101 ROOM-BED (F), [.101;1]
;.103 TREATING SPECIALTY (P45.7'), [.103;1]
;.104 PROVIDER (*P200'), [.104;1]
;.1041 ATTENDING PHYSICIAN (*P200'), [.1041;1]
;.105 CURRENT ADMISSION (*P405'), [.105;1]
;.107 LODGER WARD LOCATION (F), [.107;1] ; LODGER ONLY
;.108 CURRENT ROOM (P405.4'), [.108;1] ; LODGER ONLY
; ^DG(405.4
; PREVIOUS DISCHARGE DATE ; NON CURRENT NON LODGER
;
;
;A DIFFERENT LOGIC HAS BEEN ADOPTED FOR THE ADT DATASET
;
;USING IN5^VADPT:
; first CALL IN5^VADPT for CURRENT INFO based on the requested
; date passed to RPC. If no date sent, defaults to current date.
; if no CURRENT CALL IN5^VADPT for LODGER INFO
; if no LODGER INFO CALL IN5^VADPT for LAST DISCHARGE DATE
;
;Rows of ADT movements associated with the admission are also returned.
;See BLD for list of data elements returned for each movement.
;
GETPSARY(PSARRAY,REQDT) ;
;
; GET CURRENT MOVEMENT DATA FROM IN5^VADPT
NEW INDATA,VAIP,VAINDT,DFN,VAROOT,VAHOW,ADTTYPE
SET DFN=PTID
CURRENT K INDATA,VAIP,VAINDT
SET VAROOT="INDATA",VAHOW=2
DO IN5^VADPT SET ADTTYPE="CURRENT"
LODGER IF $P($G(INDATA(1)),"^",1)="" DO ; NO CURRENT DO LODGER
.KILL INDATA,VAIP,VAINDT
.SET VAROOT="INDATA",VAHOW=2,VAIP("L")=""
.DO IN5^VADPT SET ADTTYPE="LODGER"
LAST IF $P($G(INDATA(1)),"^",1)="" DO ; NO CURRENT AND NO LODGER DO PREVIOUS
.K INDATA,VAIP,VAINDT
.SET VAROOT="INDATA",VAHOW=2,VAIP("D")="LAST"
.DO IN5^VADPT SET ADTTYPE="DISCHARGE"
;
NEW CNT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='ADT'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RequestDate^"_DT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CurrentMovement^"_$$CURMOVE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Service^"_$$SERVICE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Provider^"_$$PROVIDE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CurrentAdmission^"_$$CURADM()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LastAdmissionDate^"_$$LASTADM()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
D ADTC(REQDT,.CNT)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
QUIT
;
ADTC(ADTDT,CNT) ;ADT Collection of all movements associated with a specifed date
NEW ROWCNT
K VAIP,VAROOT,INDATA,VAHOW
SET ADTDT=$S($G(ADTDT)'="":ADTDT\1,1:DT)
SET ROWCNT=0
SET VAIP("D")=ADTDT
SET VAIP("M")=0
SET VAIP("L")=""
DO IN5^VADPT
IF VAIP(1)'="" DO
. NEW DGRRMIEN,DGRRCA,DGRRMVDT
. SET DGRRCA=VAIP(1)
. K ^TMP($J,"DGRRMVTS")
. SET DGRRMIEN=""
. F SET DGRRMIEN=$O(^DGPM("CA",+DGRRCA,DGRRMIEN)) Q:DGRRMIEN="" D
..; Set up TMP global to assure movements are in date/time order
..S DGRRMVDT=+$P($G(^DGPM(+DGRRMIEN,0)),"^")
..I DGRRMVDT>0 S ^TMP($J,"DGRRMVTS",DGRRMVDT,DGRRMIEN)=""
. ;Loop through TMP global
.N DGRRMDT,DGRRIEN
.S DGRRMDT=""
.F S DGRRMDT=$O(^TMP($J,"DGRRMVTS",DGRRMDT)) Q:DGRRMDT="" D
.. S DGRRIEN=""
.. F S DGRRIEN=$O(^TMP($J,"DGRRMVTS",DGRRMDT,DGRRIEN)) Q:DGRRIEN="" D
... K INDATA,VAROOT,VAIP
... SET ROWCNT=$G(ROWCNT)+1
... SET VAIP("E")=DGRRIEN
... SET VAROOT="INDATA"
... DO IN5^VADPT
... S ADTTYPE=$S(+$G(INDATA(2))=4!(+$G(INDATA(2))=5):"LODGER",+$G(INDATA(2))=3:"DISCHARGE",1:"CURRENT")
... DO BLD
.K ^TMP($J,"DGRRMVTS")
IF ROWCNT=0 D
.SET ROWCNT=ROWCNT+1
.DO BLD
Q
;
BLD ;Build array of data elements for each movement. Similar to elements
;defined for current inpatient and lodger activity. The word 'current'
;removed from element names.
;
SET CNT=$G(CNT)+1,PSARRAY(CNT)="><ADTMovements Row='"_ROWCNT_"'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RequestDate^"_ADTDT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementDate^"_$$CURMOVE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Service^"_$$SERVICE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Provider^"_$$PROVIDE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^AdmissionDate^"_$$CURADM()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="></ADTMovements"
Q
CURMOVE() ;
NEW DATA
SET DATA=""
IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(3)),"^",1)
QUIT DATA
;
WARDLOC() ;
NEW DATA
SET DATA=""
IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(5)),"^",2)
QUIT DATA
;
SERVICE() ;
NEW DATA
SET DATA=""
IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(5)),"^",1)
IF ADTTYPE="CURRENT" SET DATA=$P($G(^DIC(42,+DATA,0)),"^",3)
IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,4)),"^",1)
IF ADTTYPE="DISCHARGE" SET DATA=$P($G(^DIC(42,+DATA,0)),"^",3)
QUIT DATA
;
ROOMBED() ;
NEW DATA
SET DATA=""
IF ADTTYPE="CURRENT" SET DATA=$P($G(INDATA(6)),"^",2)
QUIT DATA
;
TRETSPC() ;
NEW DATA
SET DATA=""
IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(8)),"^",2)
QUIT DATA
;
PROVIDE() ;
NEW DATA
SET DATA=""
IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(7)),"^",2)
QUIT DATA
;
ATTPHY() ;
NEW DATA
SET DATA=""
IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(18)),"^",2)
QUIT DATA
;
CURADM() ;
NEW DATA
SET DATA=""
IF ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(13,1)),"^",1)
QUIT DATA
;
TRANSTYP() ;
NEW DATA
SET DATA=""
I ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(2)),"^",2)
I ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,2)),"^",2)
QUIT DATA
;
MVTTYP() ;
NEW DATA
SET DATA=""
I ADTTYPE'="DISCHARGE" SET DATA=$P($G(INDATA(4)),"^",2)
I ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,3)),"^",2)
QUIT DATA
;
LASTADM() ;
NEW DATA
SET DATA=""
IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(13,1)),"^",1)
QUIT DATA
;
LODWLOC() ;
NEW DATA
SET DATA=""
IF ADTTYPE="LODGER" SET DATA=$P($G(INDATA(5)),"^",2)
QUIT DATA
;
LODROOM() ;
NEW DATA
SET DATA=""
IF ADTTYPE="LODGER" SET DATA=$P($G(INDATA(6)),"^",2)
QUIT DATA
;
DISDATE() ;
NEW DATA
SET DATA=""
IF ADTTYPE="DISCHARGE" SET DATA=$P($G(INDATA(17,1)),"^",1)
QUIT DATA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRPSAD 7288 printed Oct 16, 2024@18:58:17 Page 2
DGRRPSAD ; ALB/SGG - rtnDGRR PatientServices ADT Information ;09/30/03 ; Compiled December 9, 2003 15:22:22
+1 ;;5.3;Registration;**557**;Aug 13, 1993
+2 ;
DOC ;<DataSet Name='ADT'
+1 ;
+2 ;.102 CURRENT MOVEMENT (*P405'), [.102;1]
+3 ; FILE (#405) PATIENT MOVEMENT STORED IN: ^DGPM(
+4 ; .01 DATE/TIME (RDX), [0;1]
+5 ;
+6 ;.1 WARD LOCATION (FX), [.1;E1,30]
+7 ;.101 ROOM-BED (F), [.101;1]
+8 ;.103 TREATING SPECIALTY (P45.7'), [.103;1]
+9 ;.104 PROVIDER (*P200'), [.104;1]
+10 ;.1041 ATTENDING PHYSICIAN (*P200'), [.1041;1]
+11 ;.105 CURRENT ADMISSION (*P405'), [.105;1]
+12 ;.107 LODGER WARD LOCATION (F), [.107;1] ; LODGER ONLY
+13 ;.108 CURRENT ROOM (P405.4'), [.108;1] ; LODGER ONLY
+14 ; ^DG(405.4
+15 ; PREVIOUS DISCHARGE DATE ; NON CURRENT NON LODGER
+16 ;
+17 ;
+18 ;A DIFFERENT LOGIC HAS BEEN ADOPTED FOR THE ADT DATASET
+19 ;
+20 ;USING IN5^VADPT:
+21 ; first CALL IN5^VADPT for CURRENT INFO based on the requested
+22 ; date passed to RPC. If no date sent, defaults to current date.
+23 ; if no CURRENT CALL IN5^VADPT for LODGER INFO
+24 ; if no LODGER INFO CALL IN5^VADPT for LAST DISCHARGE DATE
+25 ;
+26 ;Rows of ADT movements associated with the admission are also returned.
+27 ;See BLD for list of data elements returned for each movement.
+28 ;
GETPSARY(PSARRAY,REQDT) ;
+1 ;
+2 ; GET CURRENT MOVEMENT DATA FROM IN5^VADPT
+3 NEW INDATA,VAIP,VAINDT,DFN,VAROOT,VAHOW,ADTTYPE
+4 SET DFN=PTID
CURRENT KILL INDATA,VAIP,VAINDT
+1 SET VAROOT="INDATA"
SET VAHOW=2
+2 DO IN5^VADPT
SET ADTTYPE="CURRENT"
LODGER ; NO CURRENT DO LODGER
IF $PIECE($GET(INDATA(1)),"^",1)=""
Begin DoDot:1
+1 KILL INDATA,VAIP,VAINDT
+2 SET VAROOT="INDATA"
SET VAHOW=2
SET VAIP("L")=""
+3 DO IN5^VADPT
SET ADTTYPE="LODGER"
End DoDot:1
LAST ; NO CURRENT AND NO LODGER DO PREVIOUS
IF $PIECE($GET(INDATA(1)),"^",1)=""
Begin DoDot:1
+1 KILL INDATA,VAIP,VAINDT
+2 SET VAROOT="INDATA"
SET VAHOW=2
SET VAIP("D")="LAST"
+3 DO IN5^VADPT
SET ADTTYPE="DISCHARGE"
End DoDot:1
+4 ;
+5 NEW CNT
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<DataSet Name='ADT'"
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RequestDate^"_DT
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^CurrentMovement^"_$$CURMOVE()
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Service^"_$$SERVICE()
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
+12 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
+13 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Provider^"_$$PROVIDE()
+14 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
+15 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^CurrentAdmission^"_$$CURADM()
+16 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
+17 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
+18 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^LastAdmissionDate^"_$$LASTADM()
+19 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
+20 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
+21 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
+22 DO ADTC(REQDT,.CNT)
+23 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></DataSet>"_"^^^1"
+24 QUIT
+25 ;
ADTC(ADTDT,CNT) ;ADT Collection of all movements associated with a specifed date
+1 NEW ROWCNT
+2 KILL VAIP,VAROOT,INDATA,VAHOW
+3 SET ADTDT=$SELECT($GET(ADTDT)'="":ADTDT\1,1:DT)
+4 SET ROWCNT=0
+5 SET VAIP("D")=ADTDT
+6 SET VAIP("M")=0
+7 SET VAIP("L")=""
+8 DO IN5^VADPT
+9 IF VAIP(1)'=""
Begin DoDot:1
+10 NEW DGRRMIEN,DGRRCA,DGRRMVDT
+11 SET DGRRCA=VAIP(1)
+12 KILL ^TMP($JOB,"DGRRMVTS")
+13 SET DGRRMIEN=""
+14 FOR
SET DGRRMIEN=$ORDER(^DGPM("CA",+DGRRCA,DGRRMIEN))
if DGRRMIEN=""
QUIT
Begin DoDot:2
+15 ; Set up TMP global to assure movements are in date/time order
+16 SET DGRRMVDT=+$PIECE($GET(^DGPM(+DGRRMIEN,0)),"^")
+17 IF DGRRMVDT>0
SET ^TMP($JOB,"DGRRMVTS",DGRRMVDT,DGRRMIEN)=""
End DoDot:2
+18 ;Loop through TMP global
+19 NEW DGRRMDT,DGRRIEN
+20 SET DGRRMDT=""
+21 FOR
SET DGRRMDT=$ORDER(^TMP($JOB,"DGRRMVTS",DGRRMDT))
if DGRRMDT=""
QUIT
Begin DoDot:2
+22 SET DGRRIEN=""
+23 FOR
SET DGRRIEN=$ORDER(^TMP($JOB,"DGRRMVTS",DGRRMDT,DGRRIEN))
if DGRRIEN=""
QUIT
Begin DoDot:3
+24 KILL INDATA,VAROOT,VAIP
+25 SET ROWCNT=$GET(ROWCNT)+1
+26 SET VAIP("E")=DGRRIEN
+27 SET VAROOT="INDATA"
+28 DO IN5^VADPT
+29 SET ADTTYPE=$SELECT(+$GET(INDATA(2))=4!(+$GET(INDATA(2))=5):"LODGER",+$GET(INDATA(2))=3:"DISCHARGE",1:"CURRENT")
+30 DO BLD
End DoDot:3
End DoDot:2
+31 KILL ^TMP($JOB,"DGRRMVTS")
End DoDot:1
+32 IF ROWCNT=0
Begin DoDot:1
+33 SET ROWCNT=ROWCNT+1
+34 DO BLD
End DoDot:1
+35 QUIT
+36 ;
BLD ;Build array of data elements for each movement. Similar to elements
+1 ;defined for current inpatient and lodger activity. The word 'current'
+2 ;removed from element names.
+3 ;
+4 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="><ADTMovements Row='"_ROWCNT_"'"
+5 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RequestDate^"_ADTDT
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^MovementDate^"_$$CURMOVE()
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^WardLocation^"_$$WARDLOC()
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Service^"_$$SERVICE()
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RoomBed^"_$$ROOMBED()
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^TreatingSpecialty^"_$$TRETSPC()
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Provider^"_$$PROVIDE()
+12 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^AttendingPhysician^"_$$ATTPHY()
+13 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^AdmissionDate^"_$$CURADM()
+14 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^TransactionType^"_$$TRANSTYP()
+15 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^MovementType^"_$$MVTTYP()
+16 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^LodgerWardLocation^"_$$LODWLOC()
+17 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^LodgerRoom^"_$$LODROOM()
+18 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DischargeDate^"_$$DISDATE()
+19 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></ADTMovements"
+20 QUIT
CURMOVE() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(3)),"^",1)
+4 QUIT DATA
+5 ;
WARDLOC() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="CURRENT"
SET DATA=$PIECE($GET(INDATA(5)),"^",2)
+4 QUIT DATA
+5 ;
SERVICE() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="CURRENT"
SET DATA=$PIECE($GET(INDATA(5)),"^",1)
+4 IF ADTTYPE="CURRENT"
SET DATA=$PIECE($GET(^DIC(42,+DATA,0)),"^",3)
+5 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(17,4)),"^",1)
+6 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(^DIC(42,+DATA,0)),"^",3)
+7 QUIT DATA
+8 ;
ROOMBED() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="CURRENT"
SET DATA=$PIECE($GET(INDATA(6)),"^",2)
+4 QUIT DATA
+5 ;
TRETSPC() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(8)),"^",2)
+4 QUIT DATA
+5 ;
PROVIDE() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(7)),"^",2)
+4 QUIT DATA
+5 ;
ATTPHY() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(18)),"^",2)
+4 QUIT DATA
+5 ;
CURADM() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(13,1)),"^",1)
+4 QUIT DATA
+5 ;
TRANSTYP() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(2)),"^",2)
+4 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(17,2)),"^",2)
+5 QUIT DATA
+6 ;
MVTTYP() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE'="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(4)),"^",2)
+4 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(17,3)),"^",2)
+5 QUIT DATA
+6 ;
LASTADM() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(13,1)),"^",1)
+4 QUIT DATA
+5 ;
LODWLOC() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="LODGER"
SET DATA=$PIECE($GET(INDATA(5)),"^",2)
+4 QUIT DATA
+5 ;
LODROOM() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="LODGER"
SET DATA=$PIECE($GET(INDATA(6)),"^",2)
+4 QUIT DATA
+5 ;
DISDATE() ;
+1 NEW DATA
+2 SET DATA=""
+3 IF ADTTYPE="DISCHARGE"
SET DATA=$PIECE($GET(INDATA(17,1)),"^",1)
+4 QUIT DATA