Routine: DGRRPSAD

DGRRPSAD ; ALB/SGG - rtnDGRR PatientServices ADT Information ;09/30/03  ; Compiled December 9, 2003 15:22:22

 ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

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

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"

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

DGRRPSAD  ; ALB/SGG - rtnDGRR PatientServices ADT Information ;09/30/03  ; Compiled December 9, 2003 15:22:22

 +1       ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

 +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

DGRRPSAD.m