Routine: SROACPM

SROACPM ;BIR/ADM - CARDIAC RESOURCE INFO ;12/04/07

 ;;3.0; Surgery ;**71,93,95,99,100,125,142,160,164,166**;24 Jun 93;Build 6

 ; Reference to ^DGPM("APTT1" supported by DBIA #565

 I '$D(SRTN) W !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue  " R X:DTIME G END

 S SRSOUT=0,SRSUPCPT=1 D ^SROAUTL

START G:SRSOUT END D HDR^SROAUTL

 S DIR("A",1)="Enter/Edit Patient Resource Data",DIR("A",2)=" ",DIR("A",3)="1. Capture Information from PIMS Records",DIR("A",4)="2. Enter, Edit, or Review Information",DIR("A",5)=" "

 S DIR("?",1)="Enter '1' if you want to capture patient information from PIMS",DIR("?",2)="records.  Enter '2' if you want to enter, edit, or review patient",DIR("?")="other information on this screen."

 S DIR("A")="Select Number",DIR(0)="NO^1:2" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END

 I Y=1 D PIMS G START

EDIT N DAYS,HOURS,MINS

 S:$P(^SRF(SRTN,206),"^",41)="" $P(^SRF(SRTN,206),"^",41)="N"

 S SRR=0 S SRPAGE="PAGE: 1" D HDR^SROAUTL K DR S SRQ=0,(DR,SRDR)="418;419;440;.205;.232;470;471;473;472;431;442;513;515"

 K DA,DIC,DIQ,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="IE",DR=SRDR D EN^DIQ1 K DA,DIC,DIQ,DR

 K SRZ S SRZ=0 F M=1:1 S I=$P(SRDR,";",M)  Q:'I  D

 .D TR,GET

 .S SRZ=SRZ+1,Y=$P(X,";;",2),SRFLD=$P(Y,"^"),(Z,SRZ(SRZ))=$P(Y,"^",2)_"^"_SRFLD,SREXT=SRY(130,SRTN,SRFLD,"E")

 .W:M>1 ! W $J(SRZ,2)_". "_$P(Z,"^")_": " D EXT

 D CHCK W ! F K=1:1:80 W "-"

 D SEL G:SRR=1 EDIT

 G START

CHCK ; compare admission and discharge dates to each other

 N SRADM,SRDIS,SROUT,SRDICU,SREXT

 S SROUT=SRY(130,SRTN,.232,"I"),SRDICU=SRY(130,SRTN,471,"I"),SREXT=SRY(130,SRTN,470,"I")

 S SRADM=SRY(130,SRTN,418,"I"),SRDIS=SRY(130,SRTN,419,"I") W !

 I SRADM,SRDIS,SRADM'<SRDIS W !,"*** NOTE: Discharge Date precedes Admission Date!!  Please check. ***"

 I SREXT,SROUT,SREXT'>SROUT W !,"*** NOTE: D/Time Pt Extubated should be later than the D/Time Pt Out of OR. ***"

 I SREXT,SRDICU,SREXT'<SRDICU W !,"*** NOTE: D/Time Pt Extubated should be < the ICU Discharge D/Time. ***"

 I SRDICU,SREXT,SRDICU'>SREXT W !,"*** NOTE: D/Time Discharged from ICU should be > the Extubation D/Time. ***"

 I SRDICU,SRDIS,SRDICU>SRDIS W !,"*** NOTE: D/Time Discharged from ICU should be <= the Hospital Discharge D/Time*"

EXT I SRFLD=440&(SREXT="NS") S SREXT=SREXT_"-"_$S(SREXT="NS":"No Study",1:SREXT)

 I SRFLD=470,(SREXT="NS"!(SREXT="RI")) S SREXT=SREXT_"-"_$S(SREXT="NS":"Unable to determine",SREXT="RI":"Remains intubated at 30 days",1:SREXT)

 I SRFLD=470,$G(SRY(130,SRTN,470,"I")) D  Q

 .S X=$$FMDIFF^XLFDT(SRY(130,SRTN,470,"I"),SRY(130,SRTN,.232,"I"),2) W ?39,SREXT,!,?10,"Postop Intubation Hrs: "_$FN((X/3600),"+",1)

 I SRFLD=471,(SREXT="NS"!(SREXT="RI")) S SREXT=SREXT_"-"_$S(SREXT="NS":"Unable to determine",SREXT="RI":"Remains in ICU at 30 days",1:SREXT)

 I $L(SREXT)<41 W ?39,SREXT W:SRFLD=247 $S(SREXT="":"",SREXT=1:" Day",SREXT=0:" Days",SREXT>1:" Days",1:"") Q

 I SRFLD=431 D

 .I $L(SREXT)<52 W ?28,SREXT Q

 .N I,J,X,Y S X=SREXT F  D  W:$L(X) ! I $L(X)<52!($L(X)>51&(X'[" ")) W ?28,X Q

 ..F I=0:1:50 S J=51-I,Y=$E(X,J) I Y=" " W ?28,$E(X,1,J-1) S X=$E(X,J+1,$L(X)) Q

SEL S SRSOUT=0 W !!,"Select Resource Information to Edit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 Q:X=""  S:X="a" X="A" I '$D(SRFLG),'$D(SRZ(X)),(X'?1.2N1":"1.2N),X'="A" D HELP S SRR=1 Q

 I X?1.2N1":"1.2N S Y=$P(X,":"),Z=$P(X,":",2) I Y<1!(Z>SRZ)!(Y>Z) D HELP S SRR=1 Q

 I X="A" S X="1:"_SRZ

 I X?1.2N1":"1.2N D RANGE S SRR=1 Q

 I $D(SRZ(X)),+X=X S EMILY=X D  S SRR=1

 .I $$LOCK^SROUTL(SRTN) D ONE,UNLOCK^SROUTL(SRTN)

PIMS ; get update from PIMS records

 W ! K DIR S DIR("A")="Are you sure you want to retrieve information from PIMS records ? ",DIR("B")="YES",DIR(0)="YOA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y Q

 W ! D WAIT^DICD D ^SROAPIMS

HELP W @IOF,!!!!,"Enter the number or range of numbers you want to edit.  Examples of proper",!,"responses are listed below."

 W !!,"1. Enter 'A' to update all items.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item.  (For example,",!,"   enter '1' to update "_$P(SRZ(1),"^")_".)"

 W !!,"3. Enter a range of numbers (1-"_SRZ_") separated by a ':' to enter a range",!,"   of items.  (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!

 I $D(SRFLG) W !,"4. Enter 'N' or 'NO' to enter negative response for all items.",!!,"5. Enter '@' to delete information from all items.",!

PRESS W ! K DIR S DIR("A")="Press the return key to continue or '^' to exit: ",DIR(0)="FOA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1

RANGE ; range of numbers

 I $$LOCK^SROUTL(SRTN) D  D UNLOCK^SROUTL(SRTN)

 .S SHEMP=$P(X,":"),CURLEY=$P(X,":",2) F EMILY=SHEMP:1:CURLEY Q:SRSOUT  D ONE

ONE ; edit one item

 I EMILY=7 D LIST

 I EMILY'=7 K DR,DA,DIE S DR=$P(SRZ(EMILY),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRZ(EMILY),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=1

 I 'SRSOUT,EMILY=1!(EMILY=2) D OK

 I EMILY=12 D CHK

OK ; compare admission date to discharge date

 N SRADM,SRDIS S X=$G(^SRF(SRTN,208)),SRADM=$P(X,"^",14),SRDIS=$P(X,"^",15)

 I SRADM,SRDIS,SRADM'<SRDIS W !!,"  ***  NOTE: Discharge Date precedes Admission Date!!  Please check.  ***",! D PRESS W !

CHK ; compare date OF OPERATION to CT Surgery Consult Date

 S X1=$P(^SRF(SRTN,0),"^",9),X2=$P($G(^SRF(SRTN,209)),"^",15) D ^%DTC I X'>30 S $P(^SRF(SRTN,209),"^",16)="N" Q

 S $P(^SRF(SRTN,209),"^",16)="" K DR,DA,DIE S DR=$P(SRZ(13),"^",2)_"T",DA=SRTN,DIE=130,SRDT=$P(SRZ(13),"^",3) S:SRDT DR=DR_";"_SRDT_"T" D ^DIE K DR,DA I $D(Y) S SRSOUT=1

LIST ; display list of patient movements

 N CNT,SRADM,SRLOC,SRMOVE,SRMVMT,SRN,SRT,SRTYPE,SRZ,SRY

 S DFN=$P(^SRF(SRTN,0),"^"),SRZ=$P($G(^SRF(SRTN,.2)),"^",12)

 S SRADM=0 D ADM

 S CNT=0 F  Q:'SRZ  D:SRZ MVMT

 ;Q:CNT=0

 W !!,?5,"To identify the date and time the patient was discharged from intensive",!,?5,"care following surgery, see the following list of patient movements"

 W !,?5,"that occurred during the inpatient stay associated with this surgery.",!

 S (CNT,SRN)=0 F  S CNT=$O(SRMVMT(CNT)) Q:'CNT  S X=SRMVMT(CNT),SRT=$P(X,"^",2),SRN=SRN+1 W !,$J(SRN,3)_".",?5,$P($P(X,"^"),":",1,2),?25,$P(X,"^",3),?37,$S(SRT=3:"From",1:"To")_": "_$P(X,"^",4)

 I '$O(SRMVMT(0)) W !,?5,">> No postoperative patient movements were found for this patient."

 W ! E  K DIR S DIR("A")="Select patient movement from list",DIR(0)="NO^1:"_SRN_":0" D ^DIR K DIR I Y D  Q

 .S SRT=$P($P(SRMVMT(Y),"^"),":",1,2) K DA,DIE,DR S DA=SRTN,DIE=130,DR="471///"_SRT D ^DIE K DA,DIE,DR

 K DA,DIE,DR S DA=SRTN,DIE=130,DR="471T" D ^DIE K DA,DIE,DR

MVMT S VAIP("D")=SRZ D IN5^VADPT S SRY=$P(VAIP(3),"^")

 I SRY S CNT=CNT+1 D

 .S SRMOVE=$P(VAIP(3),"^",2),SRTYPE=$P(VAIP(2),"^",1,2),SRLOC=$P(VAIP(5),"^",2)

 .S SRMVMT(CNT)=SRMOVE_"^"_SRTYPE_"^"_SRLOC

 I 'SRY S SRZ="" Q

 I VAIP(1)=VAIP(17) S SRZ="" Q

 I VAIP(16),VAIP(16)=VAIP(17) S CNT=CNT+1,SRMOVE=$P(VAIP(16,1),"^",2),SRTYPE=$P(VAIP(16,2),"^",1,2),SRLOC=$P(VAIP(16,4),"^",2),SRMVMT(CNT)=SRMOVE_"^"_SRTYPE_"^"_SRLOC,SRZ="" Q

 S SRZ=$P(VAIP(16,1),"^")

ADM N SR24 S VAIP("D")=SRZ D IN5^VADPT

 I 'VAIP(13) S X1=SRZ,X2=1 D C^%DTC S SR24=X,SRDT=$O(^DGPM("APTT1",DFN,SRZ)) Q:'SRDT!(SRDT>SR24)  S VAIP("D")=SRDT D IN5^VADPT I 'VAIP(13) S SRZ="" Q

 I VAIP(13) S SRZ=$P(VAIP(13,1),"^")+.000001

TR S J=I,J=$TR(J,"1234567890.","ABCDEFGHIJP")

GET S X=$T(@J)

END W @IOF D ^SRSKILL

DAH ;;418^Hospital Admission Date

DAI ;;419^Hospital Discharge Date

DDJ ;;440^Cardiac Catheterization Date

PBJE ;;.205^Time Patient In OR

PBCB ;;.232^Time Patient Out OR

DGJ ;;470^Date/Time Patient Extubated

DGA ;;471^Date/Time Discharged from ICU

DDB ;;442^Employment Status Preoperatively

DCA ;;431^Resource Data Comments

DGC ;;473^Homeless

DGB ;;472^Surg Performed at Non-VA Facility

EAC ;;513^CT Surgery Consult Date

EAE ;;515^Cause for Delay for Surgery

SROACPM   ;BIR/ADM - CARDIAC RESOURCE INFO ;12/04/07

 +1       ;;3.0; Surgery ;**71,93,95,99,100,125,142,160,164,166**;24 Jun 93;Build 6

 +2       ;

 +3       ; Reference to ^DGPM("APTT1" supported by DBIA #565

 +4       ;

 +5        IF '$DATA(SRTN)

               WRITE !!,"A Surgery Risk Assessment must be selected prior to using this option.",!!,"Press <RET> to continue  "

               READ X:DTIME

               GOTO END

 +6        SET SRSOUT=0

           SET SRSUPCPT=1

           DO ^SROAUTL

START      IF SRSOUT

               GOTO END

           DO HDR^SROAUTL

 +1        SET DIR("A",1)="Enter/Edit Patient Resource Data"

           SET DIR("A",2)=" "

           SET DIR("A",3)="1. Capture Information from PIMS Records"

           SET DIR("A",4)="2. Enter, Edit, or Review Information"

           SET DIR("A",5)=" "

 +2        SET DIR("?",1)="Enter '1' if you want to capture patient information from PIMS"

           SET DIR("?",2)="records.  Enter '2' if you want to enter, edit, or review patient"

           SET DIR("?")="other information on this screen."

 +3        SET DIR("A")="Select Number"

           SET DIR(0)="NO^1:2"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)!'Y

               SET SRSOUT=1

               GOTO END

 +4        IF Y=1

               DO PIMS

               GOTO START

EDIT       NEW DAYS,HOURS,MINS

 +1        IF $PIECE(^SRF(SRTN,206),"^",41)=""

               SET $PIECE(^SRF(SRTN,206),"^",41)="N"

 +2        SET SRR=0

           SET SRPAGE="PAGE: 1"

           DO HDR^SROAUTL

           KILL DR

           SET SRQ=0

           SET (DR,SRDR)="418;419;440;.205;.232;470;471;473;472;431;442;513;515"

 +3        KILL DA,DIC,DIQ,SRY

           SET DIC="^SRF("

           SET DA=SRTN

           SET DIQ="SRY"

           SET DIQ(0)="IE"

           SET DR=SRDR

           DO EN^DIQ1

           KILL DA,DIC,DIQ,DR

 +4        KILL SRZ

           SET SRZ=0

           FOR M=1:1

               SET I=$PIECE(SRDR,";",M)

               IF 'I

                   QUIT

               Begin DoDot:1

 +5                DO TR

                   DO GET

 +6                SET SRZ=SRZ+1

                   SET Y=$PIECE(X,";;",2)

                   SET SRFLD=$PIECE(Y,"^")

                   SET (Z,SRZ(SRZ))=$PIECE(Y,"^",2)_"^"_SRFLD

                   SET SREXT=SRY(130,SRTN,SRFLD,"E")

 +7                IF M>1

                       WRITE !

                   WRITE $JUSTIFY(SRZ,2)_". "_$PIECE(Z,"^")_": "

                   DO EXT

               End DoDot:1

 +8        DO CHCK

           WRITE !

           FOR K=1:1:80

               WRITE "-"

 +9        DO SEL

           IF SRR=1

               GOTO EDIT

 +10       GOTO START

 +11       QUIT

CHCK      ; compare admission and discharge dates to each other

 +1        NEW SRADM,SRDIS,SROUT,SRDICU,SREXT

 +2        SET SROUT=SRY(130,SRTN,.232,"I")

           SET SRDICU=SRY(130,SRTN,471,"I")

           SET SREXT=SRY(130,SRTN,470,"I")

 +3        SET SRADM=SRY(130,SRTN,418,"I")

           SET SRDIS=SRY(130,SRTN,419,"I")

           WRITE !

 +4        IF SRADM

               IF SRDIS

                   IF SRADM'<SRDIS

                       WRITE !,"*** NOTE: Discharge Date precedes Admission Date!!  Please check. ***"

 +5        IF SREXT

               IF SROUT

                   IF SREXT'>SROUT

                       WRITE !,"*** NOTE: D/Time Pt Extubated should be later than the D/Time Pt Out of OR. ***"

 +6        IF SREXT

               IF SRDICU

                   IF SREXT'<SRDICU

                       WRITE !,"*** NOTE: D/Time Pt Extubated should be < the ICU Discharge D/Time. ***"

 +7        IF SRDICU

               IF SREXT

                   IF SRDICU'>SREXT

                       WRITE !,"*** NOTE: D/Time Discharged from ICU should be > the Extubation D/Time. ***"

 +8        IF SRDICU

               IF SRDIS

                   IF SRDICU>SRDIS

                       WRITE !,"*** NOTE: D/Time Discharged from ICU should be <= the Hospital Discharge D/Time*"

 +9        QUIT

EXT        IF SRFLD=440&(SREXT="NS")

               SET SREXT=SREXT_"-"_$SELECT(SREXT="NS":"No Study",1:SREXT)

 +1        IF SRFLD=470

               IF (SREXT="NS"!(SREXT="RI"))

                   SET SREXT=SREXT_"-"_$SELECT(SREXT="NS":"Unable to determine",SREXT="RI":"Remains intubated at 30 days",1:SREXT)

 +2        IF SRFLD=470

               IF $GET(SRY(130,SRTN,470,"I"))

                   Begin DoDot:1

 +3                    SET X=$$FMDIFF^XLFDT(SRY(130,SRTN,470,"I"),SRY(130,SRTN,.232,"I"),2)

                       WRITE ?39,SREXT,!,?10,"Postop Intubation Hrs: "_$FNUMBER((X/3600),"+",1)

                   End DoDot:1

                   QUIT

 +4        IF SRFLD=471

               IF (SREXT="NS"!(SREXT="RI"))

                   SET SREXT=SREXT_"-"_$SELECT(SREXT="NS":"Unable to determine",SREXT="RI":"Remains in ICU at 30 days",1:SREXT)

 +5        IF $LENGTH(SREXT)<41

               WRITE ?39,SREXT

               IF SRFLD=247

                   WRITE $SELECT(SREXT="":"",SREXT=1:" Day",SREXT=0:" Days",SREXT>1:" Days",1:"")

               QUIT

 +6        IF SRFLD=431

               Begin DoDot:1

 +7                IF $LENGTH(SREXT)<52

                       WRITE ?28,SREXT

                       QUIT

 +8                NEW I,J,X,Y

                   SET X=SREXT

FOR

                       Begin DoDot:2

 +9                        FOR I=0:1:50

                               SET J=51-I

                               SET Y=$EXTRACT(X,J)

                               IF Y=" "

                                   WRITE ?28,$EXTRACT(X,1,J-1)

                                   SET X=$EXTRACT(X,J+1,$LENGTH(X))

                                   QUIT

                       End DoDot:2

                       IF $LENGTH(X)

                           WRITE !

                       IF $LENGTH(X)<52!($LENGTH(X)>51&(X'[" "))

                           WRITE ?28,X

                           QUIT

               End DoDot:1

 +10       QUIT

SEL        SET SRSOUT=0

           WRITE !!,"Select Resource Information to Edit: "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

               QUIT

 +1        IF X=""

               QUIT

           IF X="a"

               SET X="A"

           IF '$DATA(SRFLG)

               IF '$DATA(SRZ(X))

                   IF (X'?1.2N1":"1.2N)

                       IF X'="A"

                           DO HELP

                           SET SRR=1

                           QUIT

 +2        IF X?1.2N1":"1.2N

               SET Y=$PIECE(X,":")

               SET Z=$PIECE(X,":",2)

               IF Y<1!(Z>SRZ)!(Y>Z)

                   DO HELP

                   SET SRR=1

                   QUIT

 +3        IF X="A"

               SET X="1:"_SRZ

 +4        IF X?1.2N1":"1.2N

               DO RANGE

               SET SRR=1

               QUIT

 +5        IF $DATA(SRZ(X))

               IF +X=X

                   SET EMILY=X

                   Begin DoDot:1

 +6                    IF $$LOCK^SROUTL(SRTN)

                           DO ONE

                           DO UNLOCK^SROUTL(SRTN)

                   End DoDot:1

                   SET SRR=1

 +7        QUIT

PIMS      ; get update from PIMS records

 +1        WRITE !

           KILL DIR

           SET DIR("A")="Are you sure you want to retrieve information from PIMS records ? "

           SET DIR("B")="YES"

           SET DIR(0)="YOA"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)!'Y

               QUIT

 +2        WRITE !

           DO WAIT^DICD

           DO ^SROAPIMS

 +3        QUIT

HELP       WRITE @IOF,!!!!,"Enter the number or range of numbers you want to edit.  Examples of proper",!,"responses are listed below."

 +1        WRITE !!,"1. Enter 'A' to update all items.",!!,"2. Enter a number (1-"_SRZ_") to update an individual item.  (For example,",!,"   enter '1' to update "_$PIECE(SRZ(1),"^")_".)"

 +2        WRITE !!,"3. Enter a range of numbers (1-"_SRZ_") separated by a ':' to enter a range",!,"   of items.  (For example, enter '1:4' to update items 1, 2, 3 and 4.)",!

 +3        IF $DATA(SRFLG)

               WRITE !,"4. Enter 'N' or 'NO' to enter negative response for all items.",!!,"5. Enter '@' to delete information from all items.",!

PRESS      WRITE !

           KILL DIR

           SET DIR("A")="Press the return key to continue or '^' to exit: "

           SET DIR(0)="FOA"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

 +1        QUIT

RANGE     ; range of numbers

 +1        IF $$LOCK^SROUTL(SRTN)

               Begin DoDot:1

 +2                SET SHEMP=$PIECE(X,":")

                   SET CURLEY=$PIECE(X,":",2)

                   FOR EMILY=SHEMP:1:CURLEY

                       IF SRSOUT

                           QUIT

                       DO ONE

               End DoDot:1

               DO UNLOCK^SROUTL(SRTN)

 +3        QUIT

ONE       ; edit one item

 +1        IF EMILY=7

               DO LIST

 +2        IF EMILY'=7

               KILL DR,DA,DIE

               SET DR=$PIECE(SRZ(EMILY),"^",2)_"T"

               SET DA=SRTN

               SET DIE=130

               SET SRDT=$PIECE(SRZ(EMILY),"^",3)

               IF SRDT

                   SET DR=DR_";"_SRDT_"T"

               DO ^DIE

               KILL DR,DA

               IF $DATA(Y)

                   SET SRSOUT=1

 +3        IF 'SRSOUT

               IF EMILY=1!(EMILY=2)

                   DO OK

 +4        IF EMILY=12

               DO CHK

 +5        QUIT

OK        ; compare admission date to discharge date

 +1        NEW SRADM,SRDIS

           SET X=$GET(^SRF(SRTN,208))

           SET SRADM=$PIECE(X,"^",14)

           SET SRDIS=$PIECE(X,"^",15)

 +2        IF SRADM

               IF SRDIS

                   IF SRADM'<SRDIS

                       WRITE !!,"  ***  NOTE: Discharge Date precedes Admission Date!!  Please check.  ***",!

                       DO PRESS

                       WRITE !

 +3        QUIT

CHK       ; compare date OF OPERATION to CT Surgery Consult Date

 +1        SET X1=$PIECE(^SRF(SRTN,0),"^",9)

           SET X2=$PIECE($GET(^SRF(SRTN,209)),"^",15)

           DO ^%DTC

           IF X'>30

               SET $PIECE(^SRF(SRTN,209),"^",16)="N"

               QUIT

 +2        SET $PIECE(^SRF(SRTN,209),"^",16)=""

           KILL DR,DA,DIE

           SET DR=$PIECE(SRZ(13),"^",2)_"T"

           SET DA=SRTN

           SET DIE=130

           SET SRDT=$PIECE(SRZ(13),"^",3)

           IF SRDT

               SET DR=DR_";"_SRDT_"T"

           DO ^DIE

           KILL DR,DA

           IF $DATA(Y)

               SET SRSOUT=1

 +3        QUIT

LIST      ; display list of patient movements

 +1        NEW CNT,SRADM,SRLOC,SRMOVE,SRMVMT,SRN,SRT,SRTYPE,SRZ,SRY

 +2        SET DFN=$PIECE(^SRF(SRTN,0),"^")

           SET SRZ=$PIECE($GET(^SRF(SRTN,.2)),"^",12)

 +3        SET SRADM=0

           DO ADM

 +4        SET CNT=0

FOR

               IF 'SRZ

                   QUIT

               IF SRZ

                   DO MVMT

 +5       ;Q:CNT=0

 +6        WRITE !!,?5,"To identify the date and time the patient was discharged from intensive",!,?5,"care following surgery, see the following list of patient movements"

 +7        WRITE !,?5,"that occurred during the inpatient stay associated with this surgery.",!

 +8        SET (CNT,SRN)=0

FOR

               SET CNT=$ORDER(SRMVMT(CNT))

               IF 'CNT

                   QUIT

               SET X=SRMVMT(CNT)

               SET SRT=$PIECE(X,"^",2)

               SET SRN=SRN+1

               WRITE !,$JUSTIFY(SRN,3)_".",?5,$PIECE($PIECE(X,"^"),":",1,2),?25,$PIECE(X,"^",3),?37,$SELECT(SRT=3:"From",1:"To")_": "_$PIECE(X,"^",4)

 +9        IF '$ORDER(SRMVMT(0))

               WRITE !,?5,">> No postoperative patient movements were found for this patient."

 +10       WRITE !

          IF '$TEST

               KILL DIR

               SET DIR("A")="Select patient movement from list"

               SET DIR(0)="NO^1:"_SRN_":0"

               DO ^DIR

               KILL DIR

               IF Y

                   Begin DoDot:1

 +11                   SET SRT=$PIECE($PIECE(SRMVMT(Y),"^"),":",1,2)

                       KILL DA,DIE,DR

                       SET DA=SRTN

                       SET DIE=130

                       SET DR="471///"_SRT

                       DO ^DIE

                       KILL DA,DIE,DR

                   End DoDot:1

                   QUIT

 +12       KILL DA,DIE,DR

           SET DA=SRTN

           SET DIE=130

           SET DR="471T"

           DO ^DIE

           KILL DA,DIE,DR

 +13       QUIT

MVMT       SET VAIP("D")=SRZ

           DO IN5^VADPT

           SET SRY=$PIECE(VAIP(3),"^")

 +1        IF SRY

               SET CNT=CNT+1

               Begin DoDot:1

 +2                SET SRMOVE=$PIECE(VAIP(3),"^",2)

                   SET SRTYPE=$PIECE(VAIP(2),"^",1,2)

                   SET SRLOC=$PIECE(VAIP(5),"^",2)

 +3                SET SRMVMT(CNT)=SRMOVE_"^"_SRTYPE_"^"_SRLOC

               End DoDot:1

 +4        IF 'SRY

               SET SRZ=""

               QUIT

 +5        IF VAIP(1)=VAIP(17)

               SET SRZ=""

               QUIT

 +6        IF VAIP(16)

               IF VAIP(16)=VAIP(17)

                   SET CNT=CNT+1

                   SET SRMOVE=$PIECE(VAIP(16,1),"^",2)

                   SET SRTYPE=$PIECE(VAIP(16,2),"^",1,2)

                   SET SRLOC=$PIECE(VAIP(16,4),"^",2)

                   SET SRMVMT(CNT)=SRMOVE_"^"_SRTYPE_"^"_SRLOC

                   SET SRZ=""

                   QUIT

 +7        SET SRZ=$PIECE(VAIP(16,1),"^")

 +8        QUIT

ADM        NEW SR24

           SET VAIP("D")=SRZ

           DO IN5^VADPT

 +1        IF 'VAIP(13)

               SET X1=SRZ

               SET X2=1

               DO C^%DTC

               SET SR24=X

               SET SRDT=$ORDER(^DGPM("APTT1",DFN,SRZ))

               IF 'SRDT!(SRDT>SR24)

                   QUIT

               SET VAIP("D")=SRDT

               DO IN5^VADPT

               IF 'VAIP(13)

                   SET SRZ=""

                   QUIT

 +2        IF VAIP(13)

               SET SRZ=$PIECE(VAIP(13,1),"^")+.000001

 +3        QUIT

TR         SET J=I

           SET J=$TRANSLATE(J,"1234567890.","ABCDEFGHIJP")

 +1        QUIT

GET        SET X=$TEXT(@J)

 +1        QUIT

END        WRITE @IOF

           DO ^SRSKILL

 +1        QUIT

DAH       ;;418^Hospital Admission Date

DAI       ;;419^Hospital Discharge Date

DDJ       ;;440^Cardiac Catheterization Date

PBJE      ;;.205^Time Patient In OR

PBCB      ;;.232^Time Patient Out OR

DGJ       ;;470^Date/Time Patient Extubated

DGA       ;;471^Date/Time Discharged from ICU

DDB       ;;442^Employment Status Preoperatively

DCA       ;;431^Resource Data Comments

DGC       ;;473^Homeless

DGB       ;;472^Surg Performed at Non-VA Facility

EAC       ;;513^CT Surgery Consult Date

EAE       ;;515^Cause for Delay for Surgery

SROACPM.m