source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGAPP.m@ 1258

Last change on this file since 1258 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1PSGAPP ;BIR/CML3-PRINT DATA FOR ACTION PROFILE ;05 Oct 98 / 10:36 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,20,60,50,111,169**;16 DEC 97
3 ;
4LOOP ;
5 D NOW^%DTC S PSGDT=%,DT=$$DT^XLFDT,PSGPDT=$$ENDTC2^PSGMI(PSGDT),CML=IO'=IO(0)!($E(IOST,1,2)'="C-")
6 U IO I '$D(^TMP($J)) W:$Y @IOF W !?28,"UNIT DOSE ACTION PROFILE",?62,PSGPDT,!?10,"NO ACTIVE ORDERS FOUND FOR ",$S(PSGSS="G":"WARD GROUP: "_PSGAPWGN,PSGSS="W":"WARD: "_PSGAPWDN,1:"PATIENT(S) SELECTED"),"." G DONE
7 S PSGVAMC=$$SITE^PSGMMAR2(80)
8 S (LN,LINE,ALN)="",$P(LN,"_",19)="",$P(LINE,"-",81)="",$P(ALN," -",18)="",ALN=ALN_" A C T I V E"_ALN
9 S (PN,WD,TM)="" F S WD=$O(^TMP($J,WD)) Q:WD=""!$D(PSJDLW) F S TM=$O(^TMP($J,WD,TM)) Q:TM=""!$D(PSJDLW) F S PN=$O(^TMP($J,WD,TM,PN)) Q:PN=""!$D(PSJDLW) D
10 . ;naked reference on line below refers to the full reference on the line above
11 . S PI=$G(^(PN)),AMO=0 S:PI="" PI=$G(^TMP($J,WD,"zz",PN)) D H1
12 ;
13DONE ;
14 W:CML&($Y) @IOF K AD,ALN,AMO,CML,DF,LINE,LN,MF,N,PG,PI,PPN,PSGPDT,RCT,RF,PID,TD,TM,WD,PSJDLW,PSJTEAM,PSGVAMC,PSJCNTR,PSJAMO Q
15 ;
16H1 ;
17 Q:$D(PSJDLW)
18 I $E(IOST,1)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DTOUT)!$D(DUOUT) PSJDLW=1 I $D(DTOUT)!$D(DUOUT) Q
19 S (N,DF)=0,PSEX=$P(PI,"^"),PDOB=$P(PI,"^",2),PID=$P(PI,"^",3),RB=$P(PI,"^",5),AD=$P(PI,"^",6),TD=$P(PI,"^",7),WT=$P(PI,"^",8),PI=$P(PI,"^",4),PPN=$P(PN,"^",2),(DFN,PSGP)=$P(PN,"^",3)
20 S PAGE=$P(PDOB,";",2),PDOB=$P(PDOB,";"),PG=1 W:$Y @IOF W !?26,"UNIT DOSE ACTION PROFILE #1",?62,PSGPDT
21 W !?+PSGVAMC,$P(PSGVAMC,U,2)
22 W !?23,"(Continuation of VA FORM 10-1158)",?72,"Page: 1",!,LINE
23 W !," This form is to be used to REVIEW/RENEW/CANCEL existing active medication",!," orders for inpatients. Review the active orders listed and beside"
24 W " each order",!," circle one of the following:",!?30,"R - to RENEW the order",!?30,"D - to DISCONTINUE the order",!?30,"N - to take NO ACTION (the order will remain",!?34,"active until the stop date indicated)"
25 W !!," A new order must be written for any new medication or to make any changes",!," in dosage or directions on an existing order.",!,LINE,!
26 S PSJOPC="" D ENTRY^PSJHEAD(DFN,PSJOPC,PG,$G(PSJNARC),$G(PSJTEAM,1),1)
27 W !,LINE,!," No. Action",?16,"Drug",?52,"ST Start Stop Status/Info",!,ALN
28END ;
29 S (ON,DRG)="" F S DRG=$O(^TMP($J,WD,TM,PN,DRG)) Q:DRG="" F S ON=$O(^TMP($J,WD,TM,PN,DRG,ON)) Q:ON="" S ND=^(ON),SI=$G(^(ON,1)) D NP:$Y+11>IOSL Q:$D(PSJDLW) D ORDP
30 Q:$D(PSJDLW)
31 I $D(^PS(53.1,"AC",PSGP)) W !!?13,"******** THIS PATIENT HAS NON-VERIFIED ORDERS. ********"
32 S DF=1 W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE"
33 D:$Y+11>IOSL NP1 W:'$D(PSJDLW) !!!?10,"MULTIDISCIPLINARY REVIEW",!?16,"(WHEN APPROPRIATE)",?40,LN_LN,!?40,"PHARMACIST'S SIGNATURE"
34 D:$Y+7>IOSL NP1 W:'$D(PSJDLW) !!?40,LN_LN,!?40,"NURSE'S SIGNATURE"
35 ; PSJ*5*169 Standardize AMO section to 10 lines.
36 N PSJCNTR,PSJAMO
37 I IOSL-$Y>11 D
38 . W !!?3,"ADDITIONAL MEDICATION ORDERS:"
39 . F PSJCNTR=1:1:10 W !!,LINE S PSJAMO=0 I $Y+9>IOSL S PSJAMO=1 D NP1
40 . S AMO=1
41 I W !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE",!
42 E I $Y+6<IOSL F Q=$Y+5:1:IOSL-1 W !
43 W:'$D(PSJDLW) !?2,PPN,?40,PID,?78-$L(PDOB),PDOB
44 ; PSJ*5*169 Standardize AMO section to 10 lines.
45 I 'AMO D
46 .S AMO=1 D NP1 Q:$D(PSJDLW) D
47 . . W !!?3,"ADDITIONAL MEDICATION ORDERS:"
48 . . F PSJCNTR=1:1:10 W !!,LINE S PSJAMO=0 I $Y+9>IOSL S PSJAMO=1 D NP1
49 .W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE",!
50 .W:'$D(PSJDLW) !?2,PPN,?40,PID,?78-$L(PDOB),PDOB
51 Q
52 ;
53ORDP ;
54 S N=N+1 I ND="" D PRT^PSGAPIV(ON) Q
55 N X,PSG S PSGP=$P(PN,U,3)
56 D DRGDISP^PSJLMUT1(+PSGP,+ON_"U",39,65,.PSG,0)
57 S SM=$P(ND,"^",5),NF=$P(ND,"^",6) W !,$J(N,3) W $S($P(DRG,"^")="O":" ",1:" R")_" D N " ;PSJ*5*169 Don't allow RENEW for one-time orders.
58 W PSG(1),?52,$P(DRG,U),?55,$P(ND,U,2),?61,$P(ND,U,3),?67,$P(ND,U) I NF!SM!$P(ND,U,4) W ?71 W:NF "NF " W:$P(ND,U,4) "WS " W:SM $E("HSM",SM,3)
59 N X F X=1:0 S X=$O(PSG(X)) Q:'X W !?11,PSG(X)
60 I SI]"" W !?11,"Special Instructions: " F X=1:1:$L(SI," ") S Y=$P(SI," ",X) W:$X+$L(Y)>78 !?35 W Y," "
61 W ! Q
62 ;
63NP ;
64 Q:$G(PSJDLW)
65 W !!?16,LN,?40,LN_LN,!?16,"Date and Time",?40,"PROVIDER'S SIGNATURE"
66 ;
67NP1 ;
68 Q:$D(PSJDLW)
69 I $E(IOST,1)="C" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDLW=1 Q
70 I $Y+5<IOSL F Q=$Y:1:IOSL-4 W !
71 S PG=PG+1 W:'AMO !?2,PPN,?40,PID,?78-$L(PDOB),PDOB W:$Y @IOF W !?26,"UNIT DOSE ACTION PROFILE #1",?73-$L(PG),"Page: "_PG
72 W !?+PSGVAMC,$P(PSGVAMC,U,2)
73 W !?1,PPN,?40,PID,?60,PDOB
74 ; PSJ*5*169 Standardize AMO section to 10 lines.
75 I DF D Q
76 . I $G(PSJAMO)=1 W !!,"ADDITIONAL MEDICATION ORDERS (CONTINUED):",! Q
77 . W !!,LINE
78 W:'AMO !!," No. Action",?16,"Drug",?52,"ST Start Stop Status/Info",!,ALN Q
79 ;
80ENRCT ;
81 N DFN,GMRA,GMRAL,RCT,X S DFN=PSGP,GMRA="0^0^111" D EN1^GMRADPT
82 S X=0 F S X=$O(GMRAL(X)) Q:'X I $P(GMRAL(X),"^",2)]"" S RCT($P(GMRAL(X),"^",2))=""
83 I '$D(RCT) W " ____________________" Q
84 S RCT="" F X=0:1 S RCT=$O(RCT(RCT)) Q:RCT="" W:X "," W:$X+$L(RCT)>77 ! W " ",$S(RCT="NKA":"No Known Allergies",1:RCT)
85 Q
Note: See TracBrowser for help on using the repository browser.