- 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 Jan 18, 2025@03:49:23 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