Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SRTPCOM

SRTPCOM.m

Go to the documentation of this file.
  1. SRTPCOM ;BIR/SJA - COMPLETE/TRANSMIT/PRINT ASSESSMENT ;09/12/08
  1. ;;3.0;Surgery;**167,175**;24 Jun 93;Build 6
  1. S SRSOUT=0 I '$D(SRTPP) Q
  1. 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)
  1. I Y'="I" W !!,"This assessment has a "_$S(Y="C":"'COMPLETE'",1:"'TRANSMITTED'")_" status.",!!,"No action taken." G END
  1. W ! S SRFLD="" K DIR S DIR("A")="Are you ready to complete and transmit this transplant assessment? ",DIR("B")="NO",DIR(0)="YA"
  1. 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
  1. I 'Y W !!,"No action taken." G END
  1. D CHK^SRTPUTLC
  1. S SRFLD="" I $O(SRX(SRFLD))'="" D LIST
  1. S SRFLD="" I $O(SRX(SRFLD))="" G COMPLT
  1. W ! K DIR S DIR("A")="Are you sure that you want to transmit with missing information ",DIR("B")="NO",DIR(0)="Y"
  1. 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
  1. I 'Y W !!,"No action taken." G END
  1. COMPLT K DR,DIE S DA=SRTPP,DIE=139.5,DR="181///C" D ^DIE K STATUS
  1. W !,"Assessment completed and queued to transmit..." D TX
  1. K DIR W ! S DIR("A")="Do you want to print the completed assessment",DIR("B")="NO",DIR(0)="Y"
  1. S DIR("?",1)="Enter YES to print the completed assessment, or NO to return to the menu."
  1. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
  1. I 'Y S SRSOUT=1 Q
  1. 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
  1. 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
  1. D EN,END
  1. Q
  1. PRINT ; called by the Print Transplant Assessment option
  1. S SRPRINT=1 D ^SRTPSS I '$D(SRTPP) S SRSOUT=1 G END
  1. 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
  1. 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
  1. D EN
  1. ED D ^%ZISC W @IOF K SRTPP D ^SRSKILL
  1. Q
  1. LIST W @IOF,!,"This assessment is missing the following items:",! S SRZ=0,SRCNT=1
  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
  1. .I $G(SRTYPE)="H",$G(SRVA)="N",$P(SRX(SRZ,SRZ1),"^",2)=145 W !,?5,$J(SRCNT,2)_". Hypertension" S SRCNT=SRCNT+1 Q
  1. .W !,?5,$J(SRCNT,2)_". "_$P(SRX(SRZ,SRZ1),"^") S SRCNT=SRCNT+1
  1. S SRSOUT=0
  1. ;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
  1. ;Q:'Y D PRT
  1. Q
  1. 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)
  1. .I SRMD=44 D ^SRTPRACE Q
  1. .K DR,DIE S DA=SRTPP,DIE=139.5,DR=SRMD_"T" D ^DIE K DR I $D(Y) S SRSFLG=1
  1. S:'$G(SRSOUT) SRSOUT=0
  1. Q
  1. EN U IO S SRABATCH=1 D ^SRTPPAS S SRSOUT=1 Q
  1. END I 'SRSOUT,$E(IOST)'="P" D RET
  1. W @IOF I $E(IOST)="P" D ^%ZISC W @IOF
  1. D ^%ZISC W @IOF K SRTPP D ^SRSKILL
  1. Q
  1. TX ; transplant assessment transmissions
  1. S ZTDESC="Transmit Transplant Assessments",SRRTN="ONE^SRTPTMIT",ZTRTN="JOB^SRTPCOM",ZTIO="",ZTSAVE("SRRTN")="",ZTSAVE("SRTPP")="",ZTDTH=$H D ^%ZTLOAD
  1. I $D(ZTSK) W !!,"Queued as task #"_ZTSK
  1. D RET,^SRSKILL K SRRTN W @IOF
  1. Q
  1. JOB D @SRRTN S ZTREQ="@"
  1. Q
  1. RET W !! K DIR S DIR(0)="E" D ^DIR K DIR W @IOF I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
  1. Q
  1. PAGE I $E(IOST)'="P" D RET Q
  1. W @IOF,!!!
  1. Q