SRTPLST.m

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

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

 I $E(IOST)="P" D ^SRTPLSTP Q

 S SRSOUT=0,$P(LINE,"=",80)="",$P(LINE1,"-",80)="" D HDR

 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 PAGE I SRSOUT Q

 S SRA(0)=^SRT(SRTPP,0),DFN=$P(SRA(0),"^"),SRVACO=$P(^SRT(SRTPP,.01),"^",11),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")_")",?51,SRDT,?68,$S(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),!,$S($P(SRA(0),"^",3):$P(SRA(0),"^",3),1:"N/A")

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

 W !,LINE1

 Q

PAGE W !!,"Press <RET> to continue, or '^' to quit  " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 I X["?" W !!,"If you want to continue listing incomplete assessments, enter <RET>.  Enter",!,"'^' to return to the menu." G PAGE

HDR ; print heading

 S $P(LINE,"=",80)="",X="LIST OF TRANSPLANT ASSESSMENTS"

 W @IOF,!!,?(80-$L(X)\2),X

 W !,?(80-$L(SRFRTO)\2),SRFRTO

 W !!,"VACO ID",?16,"PATIENT",?51,"TRANSPLANT DATE",?68,"STATUS",!,"SURGERY CASE #",?16,"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

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

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

 +2        IF $EXTRACT(IOST)="P"

               DO ^SRTPLSTP

               QUIT 

 +3        SET SRSOUT=0

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

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

           DO HDR

 +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 PAGE

               IF SRSOUT

                   QUIT 

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

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

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

           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")_")",?51,SRDT,?68,$SELECT(Y="T":"TRANSMITTED",Y="C":"COMPLETE",Y="I":"INCOMPLETE",1:""),!,$SELECT($PIECE(SRA(0),"^",3):$PIECE(SRA(0),"^",3),1:"N/A")

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

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

 +11       WRITE !,LINE1

 +12       QUIT 

PAGE       WRITE !!,"Press <RET> to continue, or '^' to quit  "

           READ X:DTIME

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

               SET SRSOUT=1

               QUIT 

 +1        IF X["?"

               WRITE !!,"If you want to continue listing incomplete assessments, enter <RET>.  Enter",!,"'^' to return to the menu."

               GOTO PAGE

HDR       ; print heading

 +1        SET $PIECE(LINE,"=",80)=""

           SET X="LIST OF TRANSPLANT ASSESSMENTS"

 +2        WRITE @IOF,!!,?(80-$LENGTH(X)\2),X

 +3        WRITE !,?(80-$LENGTH(SRFRTO)\2),SRFRTO

 +4        WRITE !!,"VACO ID",?16,"PATIENT",?51,"TRANSPLANT DATE",?68,"STATUS",!,"SURGERY CASE #",?16,"ORGAN TYPE"

 +5        WRITE !,LINE

 +6        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