SRTPLSTP.m

SRTPLSTP ;BIR/SJA - LIST ASSESSMENTS ;04/11/08

 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27

 S (SRPAGE,SRSOUT,SRDFN)=0,$P(LINE,"=",132)="",$P(LINE1,"-",132)=""

 D HDR Q:SRSOUT

 F  S SRSD=$O(^SRT("AC",SRSD)) Q:'SRSD!(SRSD>SRED)!SRSOUT  S SRTPP=0 F  S SRTPP=$O(^SRT("AC",SRSD,SRTPP)) Q:'SRTPP!SRSOUT  S SR("RA")=$G(^SRT(SRTPP,"RA")) D

 .I (SRAST="ALL"!(SRAST[$P(SR("RA"),"^"))),$D(^SRT(SRTPP,0)),$$MANDIV(SRINSTP,SRTPP) D PRT

 Q

PRT ; print assessments)

 I '$D(^SRT(SRTPP,"RA")) Q

 I SRTYPE'="ALL",(SRTYPE'=$P(^SRT(SRTPP,"RA"),"^",2)) Q

 I $Y+5>IOSL D HDR I SRSOUT Q

 S SRA(0)=^SRT(SRTPP,0),SRVACO=$P(^SRT(SRTPP,.01),"^",11),DFN=$P(SRA(0),"^"),SR("RA")=$G(^SRT(SRTPP,"RA"))

 N I D DEM^VADPT S SRANM=VADM(1),SRASSN=VA("PID") K VADM

 I $L(SRANM)>19 S SRANM=$P(SRANM,",")_","_$E($P(SRANM,",",2))_"."

 S Y=$P(SRA(0),"^",2) D D^DIQ S SRDT=$P(Y,"@")

 S Y=$P(SR("RA"),"^")

 W !,SRVACO,?16,SRANM_" ("_VA("PID")_")",?52,SRDT,?70,$S(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),?87,$S($P(SRA(0),"^",3):$P(SRA(0),"^",3),1:"N/A")

 S Y=$P(SR("RA"),"^",2) W ?107,$S(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")

 W !,LINE1

 Q

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 S SRPAGE=SRPAGE+1 W:$Y @IOF W !,?53,"LIST OF TRANSPLANT ASSESSMENTS"

 W ?120,"PAGE "_SRPAGE,!,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGERY SERVICE",?100,"DATE REVIEWED:"

 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,"REVIEWED BY:"

 W !!,"VACO ID",?16,"PATIENT",?52,"TRANSPLANT DATE",?70,"STATUS",?87,"SURGERY CASE #",?107,"ORGAN TYPE"

 W !,LINE

 Q

MANDIV(SRINST,CASE) ;a boolean divisional call for managerial reports

 I '$D(^SRT(CASE,0)) Q 0

 I '$O(^SRO(133,1)) Q 1

 I SRINST["ALL" Q 1

 I +SRINST'>0 Q 0

 N SRDIV,SROR

 S SRDIV=$P($G(^SRT(CASE,8)),U)

 Q SRDIV=SRINST

SRTPLSTP  ;BIR/SJA - LIST ASSESSMENTS ;04/11/08

 +1       ;;3.0; Surgery ;**167**;24 Jun 93;Build 27

 +2        SET (SRPAGE,SRSOUT,SRDFN)=0

           SET $PIECE(LINE,"=",132)=""

           SET $PIECE(LINE1,"-",132)=""

 +3        DO HDR

           IF SRSOUT

               QUIT 

 +4        FOR 

               SET SRSD=$ORDER(^SRT("AC",SRSD))

               IF 'SRSD!(SRSD>SRED)!SRSOUT

                   QUIT 

               SET SRTPP=0

               FOR 

                   SET SRTPP=$ORDER(^SRT("AC",SRSD,SRTPP))

                   IF 'SRTPP!SRSOUT

                       QUIT 

                   SET SR("RA")=$GET(^SRT(SRTPP,"RA"))

                   Begin DoDot:1

 +5                    IF (SRAST="ALL"!(SRAST[$PIECE(SR("RA"),"^")))

                           IF $DATA(^SRT(SRTPP,0))

                               IF $$MANDIV(SRINSTP,SRTPP)

                                   DO PRT

                   End DoDot:1

 +6        QUIT 

PRT       ; print assessments)

 +1        IF '$DATA(^SRT(SRTPP,"RA"))

               QUIT 

 +2        IF SRTYPE'="ALL"

               IF (SRTYPE'=$PIECE(^SRT(SRTPP,"RA"),"^",2))

                   QUIT 

 +3        IF $Y+5>IOSL

               DO HDR

               IF SRSOUT

                   QUIT 

 +4        SET SRA(0)=^SRT(SRTPP,0)

           SET SRVACO=$PIECE(^SRT(SRTPP,.01),"^",11)

           SET DFN=$PIECE(SRA(0),"^")

           SET SR("RA")=$GET(^SRT(SRTPP,"RA"))

 +5        NEW I

           DO DEM^VADPT

           SET SRANM=VADM(1)

           SET SRASSN=VA("PID")

           KILL VADM

 +6        IF $LENGTH(SRANM)>19

               SET SRANM=$PIECE(SRANM,",")_","_$EXTRACT($PIECE(SRANM,",",2))_"."

 +7        SET Y=$PIECE(SRA(0),"^",2)

           DO D^DIQ

           SET SRDT=$PIECE(Y,"@")

 +8        SET Y=$PIECE(SR("RA"),"^")

 +9        WRITE !,SRVACO,?16,SRANM_" ("_VA("PID")_")",?52,SRDT,?70,$SELECT(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),?87,$SELECT($PIECE(SRA(0),"^",3):$PIECE(SRA(0),"^",3),1:"N/A")

 +10       SET Y=$PIECE(SR("RA"),"^",2)

           WRITE ?107,$SELECT(Y="LI":"LIVER",Y="LU":"LUNG",Y="K":"KIDNEY",Y="H":"HEART",1:"")

 +11       WRITE !,LINE1

 +12       QUIT 

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT 

 +2        SET SRPAGE=SRPAGE+1

           IF $Y

               WRITE @IOF

           WRITE !,?53,"LIST OF TRANSPLANT ASSESSMENTS"

 +3        WRITE ?120,"PAGE "_SRPAGE,!,?(132-$LENGTH(SRINST)\2),SRINST,!,?58,"SURGERY SERVICE",?100,"DATE REVIEWED:"

 +4        WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO,?100,"REVIEWED BY:"

 +5        WRITE !!,"VACO ID",?16,"PATIENT",?52,"TRANSPLANT DATE",?70,"STATUS",?87,"SURGERY CASE #",?107,"ORGAN TYPE"

 +6        WRITE !,LINE

 +7        QUIT 

MANDIV(SRINST,CASE) ;a boolean divisional call for managerial reports

 +1        IF '$DATA(^SRT(CASE,0))

               QUIT 0

 +2        IF '$ORDER(^SRO(133,1))

               QUIT 1

 +3        IF SRINST["ALL"

               QUIT 1

 +4        IF +SRINST'>0

               QUIT 0

 +5        NEW SRDIV,SROR

 +6        SET SRDIV=$PIECE($GET(^SRT(CASE,8)),U)

 +7        QUIT SRDIV=SRINST