SRTPCOM ;BIR/SJA - COMPLETE/TRANSMIT/PRINT ASSESSMENT ;09/12/08
;;3.0;Surgery;**167,175**;24 Jun 93;Build 6
S SRSOUT=0 I '$D(SRTPP) Q
S (SRSFLG,SRSOUT,SROVER)=0,SRA=$G(^SRT(SRTPP,"RA")),Y=$P(SRA,"^"),SRTYPE=$P(SRA,"^",2),SRNOVA=$S($P(SRA,"^",5)="N":1,1:0)
I Y'="I" W !!,"This assessment has a "_$S(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken." G END
W ! S SRFLD="" K DIR S DIR("A")="Are you ready to complete and transmit this transplant assessment? ",DIR("B")="NO",DIR(0)="YA"
S DIR("?",1)="Enter YES to complete and transmit this assessment, or enter NO to leave the",DIR("?")="status unchanged." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
I 'Y W !!,"No action taken." G END
D CHK^SRTPUTLC
S SRFLD="" I $O(SRX(SRFLD))'="" D LIST
S SRFLD="" I $O(SRX(SRFLD))="" G COMPLT
W ! K DIR S DIR("A")="Are you sure that you want to transmit with missing information ",DIR("B")="NO",DIR(0)="Y"
S DIR("?",1)="Enter YES to complete and transmit this assessment, or enter NO to leave the",DIR("?")="status unchanged." D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
I 'Y W !!,"No action taken." G END
COMPLT K DR,DIE S DA=SRTPP,DIE=139.5,DR="181///C" D ^DIE K STATUS
W !,"Assessment completed and queued to transmit..." D TX
K DIR W ! S DIR("A")="Do you want to print the completed assessment",DIR("B")="NO",DIR(0)="Y"
S DIR("?",1)="Enter YES to print the completed assessment, or NO to return to the menu."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I 'Y S SRSOUT=1 Q
K %ZIS,IO("Q"),POP S %ZIS("A")="Print the Completed Assessment on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 Q
I $D(IO("Q")) K IO("Q") S ZTDESC="Completed Surgery Transplant Assessment",(ZTSAVE("SRSITE*"),ZTSAVE("SRTPP"))="",ZTRTN="EN^SRTPCOM" D ^%ZTLOAD S SRSOUT=1 G END
D EN,END
Q
PRINT ; called by the Print Transplant Assessment option
S SRPRINT=1 D ^SRTPSS I '$D(SRTPP) S SRSOUT=1 G END
W ! K %ZIS,IO("Q"),POP S %ZIS("A")="Print the Transplant Assessment on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G ED
I $D(IO("Q")) K IO("Q") S ZTDESC="Completed Surgery Risk Assessment",ZTSAVE("SRSITE*")="",ZTSAVE("SRTPP")="",ZTRTN="EN^SRTPCOM" D ^%ZTLOAD S SRSOUT=1 G ED
D EN
ED D ^%ZISC W @IOF K SRTPP D ^SRSKILL
Q
LIST W @IOF,!,"This assessment is missing the following items:",! S SRZ=0,SRCNT=1
F S SRZ=$O(SRX(SRZ)) Q:SRZ="" S SRZ1=0 F S SRZ1=$O(SRX(SRZ,SRZ1)) Q:SRZ1="" D:$Y+5>IOSL RET Q:SRSOUT D
.I $G(SRTYPE)="H",$G(SRVA)="N",$P(SRX(SRZ,SRZ1),"^",2)=145 W !,?5,$J(SRCNT,2)_". Hypertension" S SRCNT=SRCNT+1 Q
.W !,?5,$J(SRCNT,2)_". "_$P(SRX(SRZ,SRZ1),"^") S SRCNT=SRCNT+1
S SRSOUT=0
;W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to enter the missing items at this time",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
;Q:'Y D PRT
Q
PRT S SRSOUT=0,(SRMD,SRMDD,SRODD)="",SRCNT=0 F S SRMDD=$O(SRX(SRMDD)) Q:SRMDD="" S SRODD=0 F S SRODD=$O(SRX(SRMDD,SRODD)) Q:SRODD="" S SRMD=$P($G(SRX(SRMDD,SRODD)),"^",2) D Q:$G(SRSFLG)
.I SRMD=44 D ^SRTPRACE Q
.K DR,DIE S DA=SRTPP,DIE=139.5,DR=SRMD_"T" D ^DIE K DR I $D(Y) S SRSFLG=1
S:'$G(SRSOUT) SRSOUT=0
Q
EN U IO S SRABATCH=1 D ^SRTPPAS S SRSOUT=1 Q
END I 'SRSOUT,$E(IOST)'="P" D RET
W @IOF I $E(IOST)="P" D ^%ZISC W @IOF
D ^%ZISC W @IOF K SRTPP D ^SRSKILL
Q
TX ; transplant assessment transmissions
S ZTDESC="Transmit Transplant Assessments",SRRTN="ONE^SRTPTMIT",ZTRTN="JOB^SRTPCOM",ZTIO="",ZTSAVE("SRRTN")="",ZTSAVE("SRTPP")="",ZTDTH=$H D ^%ZTLOAD
I $D(ZTSK) W !!,"Queued as task #"_ZTSK
D RET,^SRSKILL K SRRTN W @IOF
Q
JOB D @SRRTN S ZTREQ="@"
Q
RET W !! K DIR S DIR(0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
Q
PAGE I $E(IOST)'="P" D RET Q
W @IOF,!!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPCOM 3753 printed Oct 16, 2024@18:48:51 Page 2
SRTPCOM ;BIR/SJA - COMPLETE/TRANSMIT/PRINT ASSESSMENT ;09/12/08
+1 ;;3.0;Surgery;**167,175**;24 Jun 93;Build 6
+2 SET SRSOUT=0
IF '$DATA(SRTPP)
QUIT
+3 SET (SRSFLG,SRSOUT,SROVER)=0
SET SRA=$GET(^SRT(SRTPP,"RA"))
SET Y=$PIECE(SRA,"^")
SET SRTYPE=$PIECE(SRA,"^",2)
SET SRNOVA=$SELECT($PIECE(SRA,"^",5)="N":1,1:0)
+4 IF Y'="I"
WRITE !!,"This assessment has a "_$SELECT(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken."
GOTO END
+5 WRITE !
SET SRFLD=""
KILL DIR
SET DIR("A")="Are you ready to complete and transmit this transplant assessment? "
SET DIR("B")="NO"
SET DIR(0)="YA"
+6 SET DIR("?",1)="Enter YES to complete and transmit this assessment, or enter NO to leave the"
SET DIR("?")="status unchanged."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+7 IF 'Y
WRITE !!,"No action taken."
GOTO END
+8 DO CHK^SRTPUTLC
+9 SET SRFLD=""
IF $ORDER(SRX(SRFLD))'=""
DO LIST
+10 SET SRFLD=""
IF $ORDER(SRX(SRFLD))=""
GOTO COMPLT
+11 WRITE !
KILL DIR
SET DIR("A")="Are you sure that you want to transmit with missing information "
SET DIR("B")="NO"
SET DIR(0)="Y"
+12 SET DIR("?",1)="Enter YES to complete and transmit this assessment, or enter NO to leave the"
SET DIR("?")="status unchanged."
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+13 IF 'Y
WRITE !!,"No action taken."
GOTO END
COMPLT KILL DR,DIE
SET DA=SRTPP
SET DIE=139.5
SET DR="181///C"
DO ^DIE
KILL STATUS
+1 WRITE !,"Assessment completed and queued to transmit..."
DO TX
+2 KILL DIR
WRITE !
SET DIR("A")="Do you want to print the completed assessment"
SET DIR("B")="NO"
SET DIR(0)="Y"
+3 SET DIR("?",1)="Enter YES to print the completed assessment, or NO to return to the menu."
+4 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+5 IF 'Y
SET SRSOUT=1
QUIT
+6 KILL %ZIS,IO("Q"),POP
SET %ZIS("A")="Print the Completed Assessment on which Device: "
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
QUIT
+7 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Completed Surgery Transplant Assessment"
SET (ZTSAVE("SRSITE*"),ZTSAVE("SRTPP"))=""
SET ZTRTN="EN^SRTPCOM"
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
+8 DO EN
DO END
+9 QUIT
PRINT ; called by the Print Transplant Assessment option
+1 SET SRPRINT=1
DO ^SRTPSS
IF '$DATA(SRTPP)
SET SRSOUT=1
GOTO END
+2 WRITE !
KILL %ZIS,IO("Q"),POP
SET %ZIS("A")="Print the Transplant Assessment on which Device: "
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO ED
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Completed Surgery Risk Assessment"
SET ZTSAVE("SRSITE*")=""
SET ZTSAVE("SRTPP")=""
SET ZTRTN="EN^SRTPCOM"
DO ^%ZTLOAD
SET SRSOUT=1
GOTO ED
+4 DO EN
ED DO ^%ZISC
WRITE @IOF
KILL SRTPP
DO ^SRSKILL
+1 QUIT
LIST WRITE @IOF,!,"This assessment is missing the following items:",!
SET SRZ=0
SET SRCNT=1
+1 FOR
SET SRZ=$ORDER(SRX(SRZ))
if SRZ=""
QUIT
SET SRZ1=0
FOR
SET SRZ1=$ORDER(SRX(SRZ,SRZ1))
if SRZ1=""
QUIT
if $Y+5>IOSL
DO RET
if SRSOUT
QUIT
Begin DoDot:1
+2 IF $GET(SRTYPE)="H"
IF $GET(SRVA)="N"
IF $PIECE(SRX(SRZ,SRZ1),"^",2)=145
WRITE !,?5,$JUSTIFY(SRCNT,2)_". Hypertension"
SET SRCNT=SRCNT+1
QUIT
+3 WRITE !,?5,$JUSTIFY(SRCNT,2)_". "_$PIECE(SRX(SRZ,SRZ1),"^")
SET SRCNT=SRCNT+1
End DoDot:1
+4 SET SRSOUT=0
+5 ;W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to enter the missing items at this time",DIR("B")="NO" D ^DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
+6 ;Q:'Y D PRT
+7 QUIT
PRT SET SRSOUT=0
SET (SRMD,SRMDD,SRODD)=""
SET SRCNT=0
FOR
SET SRMDD=$ORDER(SRX(SRMDD))
if SRMDD=""
QUIT
SET SRODD=0
FOR
SET SRODD=$ORDER(SRX(SRMDD,SRODD))
if SRODD=""
QUIT
SET SRMD=$PIECE($GET(SRX(SRMDD,SRODD)),"^",2)
Begin DoDot:1
+1 IF SRMD=44
DO ^SRTPRACE
QUIT
+2 KILL DR,DIE
SET DA=SRTPP
SET DIE=139.5
SET DR=SRMD_"T"
DO ^DIE
KILL DR
IF $DATA(Y)
SET SRSFLG=1
End DoDot:1
if $GET(SRSFLG)
QUIT
+3 if '$GET(SRSOUT)
SET SRSOUT=0
+4 QUIT
EN USE IO
SET SRABATCH=1
DO ^SRTPPAS
SET SRSOUT=1
QUIT
END IF 'SRSOUT
IF $EXTRACT(IOST)'="P"
DO RET
+1 WRITE @IOF
IF $EXTRACT(IOST)="P"
DO ^%ZISC
WRITE @IOF
+2 DO ^%ZISC
WRITE @IOF
KILL SRTPP
DO ^SRSKILL
+3 QUIT
TX ; transplant assessment transmissions
+1 SET ZTDESC="Transmit Transplant Assessments"
SET SRRTN="ONE^SRTPTMIT"
SET ZTRTN="JOB^SRTPCOM"
SET ZTIO=""
SET ZTSAVE("SRRTN")=""
SET ZTSAVE("SRTPP")=""
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
+2 IF $DATA(ZTSK)
WRITE !!,"Queued as task #"_ZTSK
+3 DO RET
DO ^SRSKILL
KILL SRRTN
WRITE @IOF
+4 QUIT
JOB DO @SRRTN
SET ZTREQ="@"
+1 QUIT
RET WRITE !!
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE @IOF
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+1 QUIT
PAGE IF $EXTRACT(IOST)'="P"
DO RET
QUIT
+1 WRITE @IOF,!!!
+2 QUIT
