| 1 | PSOTALK2 ;BIR/EJW - SCRIPTALK ENROLLMENT FUNCTIONS ;3-28-02
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**135,182**;DEC 1997
|
|---|
| 3 | ;External reference ^PS(55 supported by DBIA 2228
|
|---|
| 4 | ;External reference ^TMP("TIUP", ^TIUPNAPI, ^TIU(8925.1 supported by DBIA 1911
|
|---|
| 5 | ENROLL ;
|
|---|
| 6 | N PSOSTEN,PSOIND,PSOLAST,DFN
|
|---|
| 7 | S PSOIND=""
|
|---|
| 8 | I '$G(PSOFIRST) D INSTR S PSOFIRST=1
|
|---|
| 9 | W !
|
|---|
| 10 | K DIC W ! S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC I Y<1!($D(DUOUT))!($D(DTOUT)) D CLEAN Q
|
|---|
| 11 | S PSOPT=+Y
|
|---|
| 12 | S DFN=PSOPT D DEM^VADPT I +$G(VADM(6)) W !,"Patient is deceased",! G ENROLL
|
|---|
| 13 | I '$D(^PS(55,PSOPT)) D
|
|---|
| 14 | .S DIC="^PS(55,",DLAYGO=55
|
|---|
| 15 | .K DD,DO S DIC(0)="L",(DINUM,X)=PSOPT D FILE^DICN D:Y<1 K DIC,DA,DR,DD,DO
|
|---|
| 16 | ..S $P(^PS(55,PSOPT,0),"^")=PSOPT K DIK S DA=PSOPT,DIK="^PS(55,",DIK(1)=.01 D EN^DIK K DIK
|
|---|
| 17 | S PSOSTEN=$G(^PS(55,"ASTALK",PSOPT))
|
|---|
| 18 | S DIR(0)="Y",DIR("A")="SCRIPTALK PATIENT" S DIR("B")=$S(PSOSTEN:"Y",1:"N") D ^DIR K DIR
|
|---|
| 19 | S PSOSTEN=Y
|
|---|
| 20 | I PSOSTEN D MAIL,GETIND
|
|---|
| 21 | D SET55
|
|---|
| 22 | D NOTE(PSOPT)
|
|---|
| 23 | K PSOIND,PSOPT,PSOSTEN,PSOLAST,X,Y
|
|---|
| 24 | G ENROLL
|
|---|
| 25 | ;
|
|---|
| 26 | SET55 ; SET MULTIPLE FOR SCRIPTALK ENROLLMENT AUDIT
|
|---|
| 27 | N PSODA,PSOERR,PSOIEN,PSOSTDT
|
|---|
| 28 | I PSOPT="" Q
|
|---|
| 29 | S PSOSTDT=$$NOW^XLFDT
|
|---|
| 30 | S PSODA(55.0108,"+1,"_PSOPT_",",.01)=PSOSTDT
|
|---|
| 31 | S PSODA(55.0108,"+1,"_PSOPT_",",1)=PSOSTEN
|
|---|
| 32 | S PSODA(55.0108,"+1,"_PSOPT_",",2)=PSOIND
|
|---|
| 33 | S PSODA(55.0108,"+1,"_PSOPT_",",3)=$G(DUZ)
|
|---|
| 34 | D UPDATE^DIE("","PSODA","PSOIEN","PSOERR")
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | GETIND ; GET INDICATION FOR ENROLLMENT
|
|---|
| 38 | S PSOLAST=$P($G(^PS(55,PSOPT,"SCTALK",0)),"^",4) I PSOLAST'="" S PSOIND=$P($G(^PS(55,PSOPT,"SCTALK",PSOLAST,0)),"^",3) ; IF PRIOR ANSWER WAS 'Y' - GET PRIOR INDICATION
|
|---|
| 39 | S DIR(0)="S^B:BLIND VETERAN;L:LOW VISION",DIR("A")="INDICATION" S DIR("B")=PSOIND D ^DIR K DIR
|
|---|
| 40 | S PSOIND=$G(Y)
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | INSTR ;
|
|---|
| 44 | W @IOF
|
|---|
| 45 | I $O(^TIU(8925.1,"B","SCRIPTALK ENROLLMENT",0))="" Q
|
|---|
| 46 | W !
|
|---|
| 47 | W !?3,"At the conclusion of this enrollment option, you will be given"
|
|---|
| 48 | W !?3,"the opportunity to sign a progress note recording the enrollment"
|
|---|
| 49 | W !?3,"of new ScripTalk patients. If you modify the record of a patient"
|
|---|
| 50 | W !?3,"that was previously enrolled, and they remain enrolled, you may"
|
|---|
| 51 | W !?3,"wish to either delete or edit the text of the generated note."
|
|---|
| 52 | W !!
|
|---|
| 53 | K PSOSQ,PSOTT,PSOSTP
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | NOTE(PSOPT) ;CREATE A PROGRESS NOTE FOR PATIENT 'PSOPT' ABOUT ENROLLMENT
|
|---|
| 57 | Q:'+$G(^PS(55,"ASTALK",PSOPT)) ; IF THIS PTS ENROLLMENT ISN'T ACTIVE
|
|---|
| 58 | S PSOTITL=$O(^TIU(8925.1,"B","SCRIPTALK ENROLLMENT",0))
|
|---|
| 59 | Q:'+PSOTITL ;IF NO TITLE ON SYSTEM
|
|---|
| 60 | S PSOPTNM=$P($G(^DPT(PSOPT,0)),U,1)
|
|---|
| 61 | S PSOLINE=1
|
|---|
| 62 | S ^TMP("TIUP",$J,PSOLINE,0)=PSOPTNM_" was enrolled in ScripTalk today, and is now eligible to receive"
|
|---|
| 63 | S PSOLINE=PSOLINE+1
|
|---|
| 64 | S ^TMP("TIUP",$J,PSOLINE,0)="prescriptions with encoded speech-capable labels."
|
|---|
| 65 | S ^TMP("TIUP",$J,0)=U_U_PSOLINE_PSOLINE_U_DT_U
|
|---|
| 66 | INSTALL K TIUDA
|
|---|
| 67 | D NEW^TIUPNAPI(.TIUDA,PSOPT,DUZ,$$NOW^XLFDT,PSOTITL)
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | CLEAN K PSOLINE,PSOPTNM,PSOTITL,PSOSTP,PSOPT,PSOFIRST
|
|---|
| 71 | K ^TMP("TIUP",$J)
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | AUDREP ;
|
|---|
| 75 | K DIC W ! S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: " D ^DIC K DIC I Y<1!($D(DUOUT))!($D(DTOUT)) Q
|
|---|
| 76 | S PSOPT=+Y
|
|---|
| 77 | S ZTSAVE("*")=""
|
|---|
| 78 | W !!,"You may queue the report to print, if you wish.",!
|
|---|
| 79 | K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
|
|---|
| 80 | I $D(IO("Q")) S ZTRTN="AUDRQ^PSOTALK2",ZTDESC="Report of ScripTalk Enrollment",ZTSAVE("*")="" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
|
|---|
| 81 | AUDRQ ;
|
|---|
| 82 | U IO
|
|---|
| 83 | S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
|
|---|
| 84 | S PSOPGCT=1
|
|---|
| 85 | D TITLEA I PSOOUT G DONE
|
|---|
| 86 | S PSOAUD=0 F S PSOAUD=$O(^PS(55,PSOPT,"SCTALK",PSOAUD)) Q:PSOAUD="" D I PSOOUT Q
|
|---|
| 87 | .S PSONODE=$G(^PS(55,PSOPT,"SCTALK",PSOAUD,0))
|
|---|
| 88 | .S PSOSTAT=$P(PSONODE,"^",2)
|
|---|
| 89 | .S PSOTIME=$$FMTE^XLFDT($P(PSONODE,U,1)),PSOTIME=$P(PSOTIME,"@")_" "_$P(PSOTIME,"@",2)
|
|---|
| 90 | .S PSOTIME=$P(PSOTIME,":",1,2)
|
|---|
| 91 | .I ($Y+5)>IOSL&('$G(PSOOUT)) D TITLEA I PSOOUT Q
|
|---|
| 92 | .W !,?2,PSOTIME
|
|---|
| 93 | .W ?25,$S(PSOSTAT:"YES",PSOSTAT=0:"NO",1:" ")
|
|---|
| 94 | .S PSOIND=$P(PSONODE,"^",3)
|
|---|
| 95 | .I 'PSOSTAT S PSOIND=""
|
|---|
| 96 | .W ?35,$S(PSOIND="B":"BLIND VETERAN",PSOIND="L":"LOW VISION",1:"")
|
|---|
| 97 | .I $P(PSONODE,"^",4)'="" D W ?52,$E(PSODUZ,1,27)
|
|---|
| 98 | ..K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_+$P(PSONODE,"^",4) D ^DIC S PSODUZ=$S(+Y:$P(Y,"^",2),1:"UNKNOWN") K DIC,X,Y
|
|---|
| 99 | I PSOOUT G DONE
|
|---|
| 100 | END ;
|
|---|
| 101 | I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
|
|---|
| 102 | I $G(PSODV)="C" W !
|
|---|
| 103 | E W @IOF
|
|---|
| 104 | DONE K PSOPT,PSOAUD,PSONODE,PSOIND,PSOSTAT,PSOPGCT,Y,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT,PSODV,PSOOUT
|
|---|
| 105 | K PSODFN,PSOIND,PSOSSN,PSOPRINT,PSONM,^TMP($J,"PSOTALK2")
|
|---|
| 106 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | TITLEA ;
|
|---|
| 110 | I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
|
|---|
| 111 | W @IOF
|
|---|
| 112 | W !,"SCRIPTALK AUDIT HISTORY" S Y=DT X ^DD("DD") W ?40,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!!
|
|---|
| 113 | S PSOPGCT=PSOPGCT+1
|
|---|
| 114 | W !,"Name: ",$E($P(^DPT(PSOPT,0),"^"),1,25)," Currently enrolled: ",$S($G(^PS(55,"ASTALK",PSOPT)):"YES",1:"NO"),!!
|
|---|
| 115 | W !?24,"Previous",?35,"Previous"
|
|---|
| 116 | W !,?2,"Date-Time Set",?25,"Status",?35,"Indication",?52,"Entered by"
|
|---|
| 117 | W !,?2,"-------------------",?24,"--------",?35,"-------------",?52,"--------------------",!
|
|---|
| 118 | Q
|
|---|
| 119 | ;
|
|---|
| 120 | ENQ ;
|
|---|
| 121 | W ! K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to report only active enrollees" D ^DIR K DIR D:$D(DIRUT) MESS G:Y["^"!($D(DIRUT)) DONE S PSOPRINT=$S(Y:1,1:0)
|
|---|
| 122 | W !!,"You may queue the report to print, if you wish.",!
|
|---|
| 123 | K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
|
|---|
| 124 | I $D(IO("Q")) S ZTRTN="RPENROLL^PSOTALK2",ZTDESC="Report of ScripTalk Enrollment",ZTSAVE("*")="" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
|
|---|
| 125 | RPENROLL ;
|
|---|
| 126 | U IO
|
|---|
| 127 | S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
|
|---|
| 128 | S PSOPGCT=1
|
|---|
| 129 | D TITLEE I PSOOUT G DONE
|
|---|
| 130 | K ^TMP($J,"PSOTALK2")
|
|---|
| 131 | D GETDFN
|
|---|
| 132 | I '$D(^TMP($J,"PSOTALK2")) W !!,"No patients to report!",!! G DONE
|
|---|
| 133 | S PSONM="" F S PSONM=$O(^TMP($J,"PSOTALK2",PSONM)) Q:PSONM="" S PSOSSN="" F S PSOSSN=$O(^TMP($J,"PSOTALK2",PSONM,PSOSSN)) Q:PSOSSN="" D I PSOOUT G DONE
|
|---|
| 134 | .S PSOIND=^TMP($J,"PSOTALK2",PSONM,PSOSSN)
|
|---|
| 135 | .I ($Y+5)>IOSL&('$G(PSOOUT)) D TITLEE I PSOOUT Q
|
|---|
| 136 | .W !,PSONM,?25," ",PSOSSN I 'PSOPRINT W ?43,$S(+$P(PSOIND,"^",3):"YES",1:"NO")
|
|---|
| 137 | .W !,?3,$S($P(PSOIND,"^",2)="B":"BLIND VETERAN",$P(PSOIND,"^",2)="L":"LOW VISION",1:" ")
|
|---|
| 138 | .W ?58,$$FMTE^XLFDT($P(PSOIND,"^")),!
|
|---|
| 139 | G END
|
|---|
| 140 | ;
|
|---|
| 141 | TITLEE ;
|
|---|
| 142 | I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
|
|---|
| 143 | W @IOF
|
|---|
| 144 | W !,"Report of ScripTalk Enrollment",?40,"Date printed: "_$$FMTE^XLFDT(DT),?70,"Page: ",PSOPGCT,!!
|
|---|
| 145 | S PSOPGCT=PSOPGCT+1
|
|---|
| 146 | W !,"Patient name",?25," SSN" I 'PSOPRINT W ?40,"Active enrollee?"
|
|---|
| 147 | W !?3,"Indication",?57,"Enrollment last updated"
|
|---|
| 148 | W !,"--------------",?25,"-----------" W:'PSOPRINT ?40,"-------------" W ?57,"-----------------------",!
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | GETDFN ;
|
|---|
| 152 | N DFN
|
|---|
| 153 | S PSODFN=0 F S PSODFN=$O(^PS(55,"ASTALK",PSODFN)) Q:PSODFN="" D
|
|---|
| 154 | .I PSOPRINT I '$G(^PS(55,"ASTALK",PSODFN)) Q
|
|---|
| 155 | .S DFN=PSODFN D DEM^VADPT I +$G(VADM(6)) Q ; DECEASED
|
|---|
| 156 | .S PSOSEQ=$P($G(^PS(55,DFN,"SCTALK",0)),"^",4)
|
|---|
| 157 | .S PSOAUD=""
|
|---|
| 158 | .I PSOSEQ'="" S PSOAUD=$G(^PS(55,DFN,"SCTALK",PSOSEQ,0))
|
|---|
| 159 | .I $G(VA("PID"))="" S VA("PID")=" "
|
|---|
| 160 | .S ^TMP($J,"PSOTALK2",VADM(1),VA("PID"))=$P(PSOAUD,"^")_"^"_$P(PSOAUD,"^",3)_"^"_$G(^PS(55,"ASTALK",PSODFN))
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | MESS W !!,"No report printed!",!!
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | MAIL ; MAKE SURE MAIL STATUS IS COMPATIBLE WITH SCRIPTALK PATIENT
|
|---|
| 167 | N MAIL
|
|---|
| 168 | S MAIL=$G(^PS(55,PSOPT,0)) I $P(MAIL,"^",3)>1 Q
|
|---|
| 169 | MAILP W !!,"REMINDER: CMOP does not fill ScripTalk prescriptions.Please select mail"
|
|---|
| 170 | W !,"status: 2 (DO NOT MAIL), 3 (LOCAL REGULAR MAIL) or 4 (LOCAL CERTFIED MAIL)."
|
|---|
| 171 | R !,"MAIL: ",MAIL:120
|
|---|
| 172 | I MAIL?1"^".E Q
|
|---|
| 173 | I MAIL<2!(MAIL>4) W !,"INVALID MAIL SETTING - ENTER 2,3, OR 4" G MAILP
|
|---|
| 174 | W " ",$S(MAIL=2:"DO NOT MAIL",MAIL=3:"LOCAL REGULAR MAIL",1:"LOCAL CERTIFIED MAIL")
|
|---|
| 175 | S $P(^PS(55,PSOPT,0),"^",3)=MAIL
|
|---|
| 176 | Q
|
|---|
