| 1 | PSBPRND ;BIRMINGHAM/EFC-BCMA PRN DOCUMENTING ;May 2002
|
|---|
| 2 | ;;2.0;BAR CODE MED ADMIN;**32**;May 2002
|
|---|
| 3 | ;
|
|---|
| 4 | ;Queue the routine
|
|---|
| 5 | ENV(PSBPRNDT,PSBSTRT,PSBDUZ,PRNMSG) ;
|
|---|
| 6 | I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined." Q
|
|---|
| 7 | K ZTSAVE,ZTSK S ZTRTN="PROCESS^PSBPRND(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM)",ZTDESC="BCMA PRN DOCUMENTATION",ZTIO=""
|
|---|
| 8 | W !!
|
|---|
| 9 | S ZTSAVE("PSBPRNDT")=""
|
|---|
| 10 | S ZTSAVE("PSBSTRTE")=""
|
|---|
| 11 | S ZTSAVE("PSBDUZ")=""
|
|---|
| 12 | S ZTSAVE("PSBPRNM")=""
|
|---|
| 13 | D ^%ZTLOAD
|
|---|
| 14 | I $D(ZTSK) D
|
|---|
| 15 | .W !!,"The PRN effectiveness documenting process was ",$S($G(ZTSK):"",1:"NOT"),"queued",!
|
|---|
| 16 | .W !," TASK#: "_$G(ZTSK)
|
|---|
| 17 | Q
|
|---|
| 18 | PSBPRNS ;Document all administrations of a PRN order that have NOT had
|
|---|
| 19 | ; the PRN Effectiveness documented for dates user provided
|
|---|
| 20 | ;
|
|---|
| 21 | N PSBIEN
|
|---|
| 22 | I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined." Q
|
|---|
| 23 | S PSBDUZ=$G(DUZ)
|
|---|
| 24 | D HEADER
|
|---|
| 25 | ;get start date
|
|---|
| 26 | S %DT="AEQ",%DT("A")="Select Date to Process From: "
|
|---|
| 27 | S %DT("B")=""
|
|---|
| 28 | W ! D ^%DT Q:+Y<1 S PSBDT=Y
|
|---|
| 29 | S PSBPRNDT=PSBDT D D^DIQ
|
|---|
| 30 | ;Get stop date
|
|---|
| 31 | S %DT="AEQ",%DT("A")="Select Date to Process Up to: "
|
|---|
| 32 | S %DT("B")=""
|
|---|
| 33 | W ! D ^%DT Q:+Y<1 S PSBDTA=Y
|
|---|
| 34 | S PSBSTRTE=PSBDTA D D^DIQ
|
|---|
| 35 | I PSBPRNDT>PSBSTRTE W !,"Start date cannot be greater than end date" Q
|
|---|
| 36 | ;Write user running routine
|
|---|
| 37 | S PSBNAME=$P(^VA(200,PSBDUZ,0),"^",1)
|
|---|
| 38 | W !!,"PRN effectiveness entered by: ",PSBNAME,!
|
|---|
| 39 | D HEADER
|
|---|
| 40 | ;COMMIT OR QUIT
|
|---|
| 41 | S Y=PSBDTA D DD^%DT S PSBRDT=Y
|
|---|
| 42 | S Y=PSBPRNDT D DD^%DT S PSBRDTA=Y
|
|---|
| 43 | W !!!,?10,"**PRN DOCUMENTATION WILL BE FILED FOR THE FOLLOWING**"
|
|---|
| 44 | W !!,?5,"PRN START DATE...........: ",PSBRDTA
|
|---|
| 45 | W !,?5,"PRN END DATE.............: ",PSBRDT
|
|---|
| 46 | W !,?5,"PRN ENTERED BY...........: ",PSBNAME
|
|---|
| 47 | W !,?5,"PRN DOCUMENTATION STATEMENT: "
|
|---|
| 48 | ;Set mesage to be used
|
|---|
| 49 | S PSBPRNM="Administrative Closure"
|
|---|
| 50 | I $L(PSBPRNM)>0 D
|
|---|
| 51 | .W ?9,$E(PSBPRNM,1,52)
|
|---|
| 52 | R !!,"Would you like to CONTINUE ? (Y/N):",PSBANS:30
|
|---|
| 53 | S PSBFLAG=""
|
|---|
| 54 | I (PSBANS["Y")!(PSBANS="y") S PSBFLAG=1
|
|---|
| 55 | I PSBFLAG'=1 D Q
|
|---|
| 56 | .W !!,"You have chosen not to continue! Application ending!!"
|
|---|
| 57 | D HEADER
|
|---|
| 58 | D ENV(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM)
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | PROCESS(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM) ;
|
|---|
| 62 | ;Gather Patient DFN
|
|---|
| 63 | S PSBSRTD=PSBSTRTE+1
|
|---|
| 64 | S PSBPRTA=PSBPRNDT-1
|
|---|
| 65 | S PSBCNT="0"
|
|---|
| 66 | S DFN="" F S DFN=$O(^PSB(53.79,"APRN",DFN)) Q:DFN="" D
|
|---|
| 67 | .S PSBSTRT="" F S PSBSTRT=$O(^PSB(53.79,"APRN",DFN,PSBSTRT)) Q:PSBSTRT="" D
|
|---|
| 68 | ..I PSBSTRT>PSBPRTA,PSBSTRT<PSBSRTD D
|
|---|
| 69 | ...S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"APRN",DFN,PSBSTRT,PSBIEN)) Q:'PSBIEN D
|
|---|
| 70 | ....I ($P(^PSB(53.79,PSBIEN,0),U,9)'="G")&($P(^PSB(53.79,PSBIEN,0),U,9)'="RM") Q ;Med was never given
|
|---|
| 71 | ....Q:$P($G(^PSB(53.79,PSBIEN,.2)),U,2)]"" ;PRN already entered
|
|---|
| 72 | ....D FILEIT(PSBIEN,PSBPRNM)
|
|---|
| 73 | ....;increment counter
|
|---|
| 74 | ....S PSBCNT=PSBCNT+1
|
|---|
| 75 | ;Email the results
|
|---|
| 76 | D PSBEMAIL(PSBCNT,PSBPRNM,PSBSTRTE,PSBPRNDT,PSBDUZ)
|
|---|
| 77 | K PSBCNT,PSBPRNM,PSBDTA,PSBPRNDT,PSBDUZ,PSBPRMG,PSBSTRTE
|
|---|
| 78 | K PSBSRTD,PSBPRTA
|
|---|
| 79 | Q
|
|---|
| 80 | ;File PRN
|
|---|
| 81 | FILEIT(PSBIEN,PSBPRNM) ;
|
|---|
| 82 | ;
|
|---|
| 83 | S PSBREC(0)=PSBPRNM
|
|---|
| 84 | S PSBIEN=PSBIEN_","
|
|---|
| 85 | D VAL^PSBML(53.79,PSBIEN,.22,PSBREC(0))
|
|---|
| 86 | D FILEIT^PSBML
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | ;
|
|---|
| 90 | HEADER ;Header
|
|---|
| 91 | W #
|
|---|
| 92 | W !,$TR($J("",IOM)," ","-")
|
|---|
| 93 | W !,?23,"PRN EFFECTIVENESS DOCUMENTATION ROUTINE"
|
|---|
| 94 | W !,$TR($J("",IOM)," ","-")
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | ;
|
|---|
| 98 | PSBEMAIL(PSB1,PSB2,PSB3,PSB4,PSB5) ;
|
|---|
| 99 | ; PSB1 = PRN Count
|
|---|
| 100 | ; PSB2 = PRN message to file
|
|---|
| 101 | ; PSB3 = START date for search
|
|---|
| 102 | ; PSB4 = FINISH date for search
|
|---|
| 103 | ; PSB5 = DUZ for PRN entered by
|
|---|
| 104 | ; Send PRN documentation changes to user
|
|---|
| 105 | S Y=PSB3 D DD^%DT S PSB3X=Y
|
|---|
| 106 | S Y=PSB4 D DD^%DT S PSB4X=Y
|
|---|
| 107 | S PSB5=$P(^VA(200,PSB5,0),"^",1)
|
|---|
| 108 | S PSBMG=DUZ ;
|
|---|
| 109 | Q:PSBMG=""
|
|---|
| 110 | S PSBMSG(1)=" "
|
|---|
| 111 | S PSBMSG(2)=" PRN effectiveness not documented have been fixed. "
|
|---|
| 112 | S PSBMSG(3)=" "
|
|---|
| 113 | S PSBMSG(4)=" PRN effectiveness entered by.: "_PSB5
|
|---|
| 114 | S PSBMSG(5)=" Number of PRNs documented....: "_PSB1
|
|---|
| 115 | S PSBMSG(6)=" Start Date.......: "_PSB4X
|
|---|
| 116 | S PSBMSG(7)=" Finish Date......: "_PSB3X
|
|---|
| 117 | S PSBMSG(8)=" Message documented for PRNs..: "_PSB2
|
|---|
| 118 | S PSBMSG(9)=" "
|
|---|
| 119 | S PSBMSG(10)=" "
|
|---|
| 120 | S PSBMSG(11)=" "
|
|---|
| 121 | S PSBMSG(12)=""
|
|---|
| 122 | S PSBMSG(13)=" "
|
|---|
| 123 | S PSBMSG(14)=" "
|
|---|
| 124 | S PSBMSG(15)=" "
|
|---|
| 125 | S XMY(DUZ)="",XMTEXT="PSBMSG(",XMSUB="BCMA PRN DOCUMENTATION Notification."
|
|---|
| 126 | D ^XMD
|
|---|
| 127 | K PSB1,PSB2,PSB3,PSB4,PSB5,PSB4X,PSB3X
|
|---|
| 128 | K PSBMSG,PSBMG,XMY,XMSUB,XMTEXT
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | ;
|
|---|
| 132 | ;
|
|---|
| 133 | ;
|
|---|
| 134 | ;
|
|---|
