Changeset 623 for WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBO.m
r613 r623 1 PSBO 2 ;;3.0;BAR CODE MED ADMIN;**13,32,2**;Mar 2004;Build 223 4 5 6 7 8 9 10 RPC(RESULTS,PSBTYPE,PSBDFN,PSBSTRT,PSBSTOP,PSBINCL,PSBDEV,PSBSORT,PSBOI,PSBWLOC,PSBWSORT,PSBFUTR,PSBORDNM,PSBRCRI,PSBLIST) 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 XQ(PSBTYPE) 65 66 67 68 69 70 71 72 73 .I (PSBTYPE="BL")!(PSBTYPE="BZ")S PSBANS="" D CHECK I PSBANS=0!($D(DIRUT)) W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!" Q74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 DQ(PSBRPT) 93 94 95 96 97 98 99 100 101 IOM() 102 103 104 105 106 107 108 109 VAL(PSBFLDS) 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 SETUP() 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 WRAP(X,Y,Z) 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 CHECK 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 1 PSBO ;BIRMINGHAM/EFC-BCMA OUTPUTS ;Mar 2004 2 ;;3.0;BAR CODE MED ADMIN;**13,32**;Mar 2004;Build 32 3 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified. 4 ; Reference/IA 5 ; ^DPT(/10035 6 ; WARD^NURSUT5/3052 7 ; EN^PSJBCMA/2828 8 ; ^ORD(101.24/3429 9 ; ^PSDRUG(/221 10 RPC(RESULTS,PSBTYPE,PSBDFN,PSBSTRT,PSBSTOP,PSBINCL,PSBDEV,PSBSORT,PSBOI,PSBWLOC,PSBWSORT,PSBFUTR,PSBORDNM,PSBRCRI,PSBLIST) ; 11 ; 12 ; RPC: PSB REPORT 13 ; 14 ; Description: 15 ; Used by the client to create individual patient extracts of 16 ; CHUI report options to display on the client. 17 ; 18 S RESULTS=$NAME(^TMP("PSBO",$J)) 19 N PSBIENS,PSBRPT,PSBFDA,DIC,PSBANS 20 K ^TMP("PSBO",$J) S ^TMP("PSBO",$J,1)="-1^" 21 S DFN=PSBDFN 22 D NEW^PSBO1(.PSBRPT,PSBTYPE) 23 I +PSBRPT(0)<1 S ^TMP("PSBO",$J,1)="-1^Error: "_$P(PSBRPT(0),U,2) Q 24 S PSBIENS=+PSBRPT(0)_"," 25 S PSBSTRT(0)=$E($P(PSBSTRT,".",2)_"0000",1,4),PSBSTRT=PSBSTRT\1 26 S PSBSTOP(0)=$E($P(PSBSTOP,".",2)_"0000",1,4),PSBSTOP=PSBSTOP\1 27 D:$G(PSBDEV)]"" 28 .D NOW^%DTC 29 .I $P(PSBDEV,U,2)="" D VAL^DIE(53.69,PSBIENS,.06,"F",PSBDEV,"PSBRET","PSBFDA") 30 .I $P(PSBDEV,U,2)'="" D VAL^DIE(53.69,PSBIENS,.06,"F","`"_$P(PSBDEV,U,2),"PSBRET","PSBFDA") 31 .D VAL^DIE(53.69,PSBIENS,.07,"F",$S($P(PSBRCRI,U)="QD":$P(PSBRCRI,U,2),1:%),"PSBRET","PSBFDA") 32 D:$G(PSBOI)]"" VAL^DIE(53.69,PSBIENS,.09,"F",PSBOI,"PSBRET","PSBFDA") 33 S:($G(PSBSORT)']"")&(PSBTYPE'="XA") PSBSORT="P" D VAL^DIE(53.69,PSBIENS,.11,"F",PSBSORT,"PSBRET","PSBFDA") 34 D VAL^DIE(53.69,PSBIENS,.12,"F","`"_PSBDFN,"PSBRET","PSBFDA") 35 I $G(PSBWLOC)]"" S PSBFDA(53.69,PSBIENS,.13)=PSBWLOC 36 D:$G(PSBWSORT)]"" VAL^DIE(53.69,PSBIENS,.15,"F",PSBWSORT,"PSBRET","PSBFDA") 37 D VAL^DIE(53.69,PSBIENS,.16,"F",PSBSTRT,"PSBRET","PSBFDA") 38 D VAL^DIE(53.69,PSBIENS,.17,"F",PSBSTRT(0),"PSBRET","PSBFDA") 39 D VAL^DIE(53.69,PSBIENS,.18,"F",PSBSTOP,"PSBRET","PSBFDA") 40 D VAL^DIE(53.69,PSBIENS,.19,"F",PSBSTOP(0),"PSBRET","PSBFDA") 41 D:$G(PSBINCL)]"" 42 .D VAL^DIE(53.69,PSBIENS,.21,"F",+$P(PSBINCL,"^",1),"PSBRET","PSBFDA") 43 .D VAL^DIE(53.69,PSBIENS,.22,"F",+$P(PSBINCL,"^",2),"PSBRET","PSBFDA") 44 .D VAL^DIE(53.69,PSBIENS,.23,"F",+$P(PSBINCL,"^",3),"PSBRET","PSBFDA") 45 .D VAL^DIE(53.69,PSBIENS,.24,"F",+$P(PSBINCL,"^",4),"PSBRET","PSBFDA") 46 .D VAL^DIE(53.69,PSBIENS,.28,"F",+$P(PSBINCL,"^",5),"PSBRET","PSBFDA") 47 .D VAL^DIE(53.69,PSBIENS,.29,"F",+$P(PSBINCL,"^",6),"PSBRET","PSBFDA") 48 D:$G(PSBFUTR)]"" 49 .D VAL^DIE(53.69,PSBIENS,.25,"F",+$P(PSBFUTR,"^",1),"PSBRET","PSBFDA") 50 .D VAL^DIE(53.69,PSBIENS,.26,"F",+$P(PSBFUTR,"^",2),"PSBRET","PSBFDA") 51 .D VAL^DIE(53.69,PSBIENS,.27,"F",+$P(PSBFUTR,"^",3),"PSBRET","PSBFDA") 52 .D VAL^DIE(53.69,PSBIENS,.41,"F",+$P(PSBFUTR,"^",4),"PSBRET","PSBFDA") 53 .D VAL^DIE(53.69,PSBIENS,.61,"F",$TR(PSBFUTR,"^ ","~"),"PSBRET","PSBFDA") 54 D FILE^DIE("","PSBFDA") 55 I $G(PSBLIST(0),"")]"" D LIST^PSBO1(.PSBLIST) 56 I $G(PSBDEV)]"" D PRINT^PSBO1 S RESULTS=$NAME(^TMP("PSBO",$J)) Q 57 D HFSOPEN^PSBUTL("RPC") I POP S ^TMP("PSBO",$J,1)="ERROR: UNABLE TO ACCESS HFS DIRECTORY "_$$GET^XPAR("DIV","PSB HFS SCRATCH"),^TMP("PSBO",$J,2)="PLEASE CHECK DIRECTORY WRITE PRIVILEDGES." Q 58 U IO D DQ(+PSBIENS) 59 D HFSCLOSE^PSBUTL("RPC") 60 S RESULTS=$NAME(^TMP("PSBO",$J)) 61 D:$G(PSBDEV)]"" PRINT^PSBO1 62 Q 63 ; 64 XQ(PSBTYPE) ; Called via Kernel Menus 65 N PSBANS,PSBANS1,PSBRPT,PSBSAVE,DA,DIK,DR,DDSFILE 66 D NEW^PSBO1(.PSBRPT,PSBTYPE) 67 I +PSBRPT(0)<1 W !,"Error: ",$P(PSBRPT(0),U,2) S DIR(0)="E" D ^DIR Q 68 S DA=+PSBRPT(0),DR="[PSBO "_PSBTYPE_"]",DDSFILE=53.69 D ^DDS 69 W @IOF 70 I 'PSBSAVE W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!" 71 D:PSBSAVE 72 .;Check Drug to Patient Relationship. 73 .I PSBTYPE="BL" S PSBANS="" D CHECK I PSBANS=0!($D(DIRUT)) W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!" Q 74 .; 75 .;Allow "'BROWSER" Device 76 .S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0 I IOP]"" D 77 ..S IOP="`"_IOP,%ZIS="N" 78 ..D ^%ZIS 79 ..I IO=IO(0) S PSBSIO=1 80 ..D HOME^%ZIS K IOP 81 .I $$GET1^DIQ(53.69,DA_",",.06)["BROWSER"!(PSBSIO=1) S IOP=$$GET1^DIQ(53.69,DA_",",.06)_";132" D ^%ZIS U IO D DQ(DA) D ^%ZISC K IOP Q 82 .W @IOF,"Submitting Your Report Request to Taskman..." 83 .S ZTIO=$$GET1^DIQ(53.69,DA_",",.06) 84 .S ZTDTH=$P(^PSB(53.69,DA,0),U,7) 85 .S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05) 86 .S ZTRTN="DQ^PSBO("_DA_")" 87 .D ^%ZTLOAD 88 .W "Submitted!",!,"Your Task Number Is: ",$G(ZTSK),! 89 K ^TMP("PSBO",$J) 90 Q 91 ; 92 DQ(PSBRPT) ; Dequeue report from Taskman 93 N PSBWRD,PSBDFN 94 Q:'$D(^PSB(53.69,PSBRPT,0)) ; No Such Report 95 S $P(^PSB(53.69,PSBRPT,0),U,8)=$G(ZTSK,"RPC") 96 D:$$SETUP @("EN^PSBO"_$P(PSBRPT(0),U,5)) 97 K ^TMP("PSBO",$J) 98 S ZTREQ="@" 99 Q 100 ; 101 IOM() ; Returns good margin or not 102 Q:IOM'<132 1 103 W !,"**************************************************************" 104 W !,"* SORRY, Your selected DEVICE does not print 132 columns. *" 105 W !,"**************************************************************" 106 W ! 107 Q 0 108 ; 109 VAL(PSBFLDS) ; Validate that fields in PSBFLDS are filled in 110 N PSB,PSBFLD,PSBMSG,PSBSTOP,PSBST,PSBDAYS S PSBSTRT="" 111 F PSB=1:1 Q:$P(PSBFLDS,";",PSB)="" S PSBFLD=$P(PSBFLDS,";",PSB),PSBFLD(PSBFLD)=$$GET^DDSVAL(53.69,DA,PSBFLD) 112 I $D(PSBFLD(.11)) K:$E(PSBFLD(.11))="P" PSBFLD(.13),PSBFLD(.15) K:$E(PSBFLD(.11))="W" PSBFLD(.12) 113 S PSB="" F S PSB=$O(PSBFLD(PSB)) Q:PSB="" D:PSBFLD(PSB)="" 114 .I '$D(PSBMSG) S PSBMSG(0)="UNABLE TO FILE REQUEST",PSBMSG(1)=" ",PSBMSG(2)="ERROR: MISSING DATA - ALL FIELDS ARE REQUIRED",PSBMSG(3)=" " 115 .D FIELD^DID(53.69,PSB,"","TITLE;LABEL","PSB") 116 .S Z=" Missing Field: "_$S(PSB("TITLE")]"":PSB("TITLE"),1:PSB("LABEL")) 117 .S PSBMSG($O(PSBMSG(""),-1)+1)=Z 118 ; Check Times 119 D:$G(PSBFLD(.16)) 120 .S PSBSTRT=PSBFLD(.16)+$G(PSBFLD(.17)) 121 .D:$P($$GET1^DIQ(53.69,DA_",",.01),U)["MH" 122 ..S PSBDAYS=$$GET1^DIQ(101.24,$$FIND1^DIC(101.24,"","X","ORRP BCMA MAH","B")_",",.42) ;check maxdays 123 ..S:PSBDAYS="" PSBDAYS=7 124 ..S X=PSBSTRT\1 D H^%DTC S PSBST=%H+PSBDAYS ;Determine stop date 125 .S PSBSTOP=$S($G(PSBFLD(.18)):PSBFLD(.18),1:PSBFLD(.16))+$G(PSBFLD(.19)) 126 .I PSBSTOP<PSBSTRT S Y=$O(PSBMSG(""),-1)+1,PSBMSG(Y)=" Date: Stop Date/Time is before Start Date/Time" 127 .I $P($$GET1^DIQ(53.69,DA_",",.01),U)["MH" S X=PSBSTOP\1 D H^%DTC I %H>PSBST S Y=$O(PSBMSG(""),-1)+1,PSBMSG(Y)=" The date range cannot exceed "_PSBDAYS_" day(s) as defined in the CPRS 'MAXIMUM DAYS BACK' parameter" 128 Q:'$D(PSBMSG) ; All is well 129 D MSG^DDSUTL(.PSBMSG) 130 S DDSERROR=1 131 Q 132 ; 133 SETUP() ; Setup parameters for the report in PSBRPT 134 N PSBWRDL,PSBINDX,PSBWRDA 135 K ^TMP("PSBO",$J) 136 F X=0,.1,.2,.3,.4,1 S PSBRPT(X)=$G(^PSB(53.69,PSBRPT,X)) 137 I $D(^PSB(53.69,PSBRPT,2)) M PSBRPT(2)=^PSB(53.69,PSBRPT,2) 138 I $P(PSBRPT(.1),U,1)="P" S PSBDFN=+$P(PSBRPT(.1),U,2) Q:'PSBDFN S ^TMP("PSBO",$J,PSBDFN,0)=$P(^DPT(PSBDFN,0),U)_U_$P(^DPT(PSBDFN,0),U,9),^TMP("PSBO",$J,"B",$P(^DPT(PSBDFN,0),U),PSBDFN)="" 139 D:$P(PSBRPT(.1),U,1)="W" 140 .S PSBWRD=$P(PSBRPT(.1),U,3) Q:'PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA) 141 .S X="" F S X=$O(PSBWRDA(PSBWRD,2,X)) Q:X="" S PSBWRDL=$P(PSBWRDA(PSBWRD,2,X,.01),U,2) D 142 ..F PSBDFN=0:0 S PSBDFN=$O(^DPT("CN",PSBWRDL,PSBDFN)) Q:'PSBDFN D 143 ...S ^TMP("PSBO",$J,PSBDFN,0)=$P(^DPT(PSBDFN,0),U)_U_$P(^DPT(PSBDFN,0),U,9) 144 ...; Determine Sort or default to Pt Name... 145 ...S:$P(PSBRPT(.1),U,5)="P" PSBINDX=$P(^DPT(PSBDFN,0),U) 146 ...I $P(PSBRPT(.1),U,5)="B" S PSBINDX=$P($G(^DPT(PSBDFN,.101)),U) S:PSBINDX="" PSBINDX="** NO ROOM BED **" 147 ...S:$P(PSBRPT(.1),U,5)="" PSBINDX=$P(^DPT(PSBDFN,0),U) 148 ...S:$G(PSBINDX)="" PSBINDX=$P(^DPT(PSBDFN,0),U) 149 ...S ^TMP("PSBO",$J,"B",PSBINDX,PSBDFN)="" 150 Q 1 151 ; 152 WRAP(X,Y,Z) ; Quick text wrap 153 ; 154 ; Input Parameters Description: 155 ; X: Left Column of display [Optional] 156 ; Y: Cols to wrap in [Optional] 157 ; Z: Text to wrap [Optional] 158 ; 159 N PSB 160 F Q:'$L(Z) D 161 .W:$X>X ! 162 .W:$X<X ?X 163 .I $L(Z)<Y W Z S Z="" Q 164 .F PSB=Y:-1:0 Q:$E(Z,PSB)=" " 165 .S:PSB<1 PSB=Y 166 .W $E(Z,1,PSB) 167 .S Z=$E(Z,PSB+1,250) 168 Q "" 169 ; 170 CHECK ;Beginning of PSB*1*10 171 K ^TMP("PSJ",$J) 172 N PSBDFN,PSBBAR,PSBDRUG,PSBFLAG,PSBPNM,PSBNDX,PSBX 173 S PSBFLAG="",PSBBAR=$P($P($G(^PSB(53.69,DA,.3)),U,1),"~",2) 174 S PSBDRUG=$$GET1^DIQ(53.69,DA_",",.31) 175 S PSBDFN=$$GET1^DIQ(53.69,DA_",",.12,"I") S:$G(PSBDFN) PSBFLAG=1 176 D EN^PSJBCMA(PSBDFN) 177 F PSBX=0:0 S PSBX=$O(^TMP("PSJ",$J,PSBX)) Q:'PSBX D 178 .K Y,PSBORD,PSBPNM,PSBNDX 179 .M PSBORD=^TMP("PSJ",$J,PSBX) 180 .F PSBNDX=700,850,950 D 181 ..F Y=0:0 S Y=$O(PSBORD(PSBNDX,Y)) Q:'Y D 182 ...I $P($G(PSBORD(1)),U,7)'="A" Q 183 ...S PSBPNM=$P(PSBORD(PSBNDX,Y,0),U,1) 184 ...I PSBNDX=700,PSBPNM=PSBBAR S PSBFLAG=0 Q 185 ...I PSBNDX=850,$D(^PSDRUG("A526",PSBBAR,PSBPNM)) S PSBFLAG=0 Q 186 ...I PSBNDX=950,$D(^PSDRUG("A527",PSBBAR,PSBPNM)) S PSBFLAG=0 187 I PSBFLAG=1 D 188 .W !,"Patient is not currently on medication: ",PSBDRUG 189 .K DIRUT,DIR 190 .S DIR("A")="Do you want to continue" 191 .S DIR(0)="Y" 192 .D ^DIR 193 .S PSBANS=+Y W ! 194 ;
Note:
See TracChangeset
for help on using the changeset viewer.
