source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGCAPP.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PSGCAPP ;BIR/CML3-PRINT DATA FOR ACTION PROFILE ;05 Oct 98 / 10:21 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,20,60,111,149,169**;16 DEC 97
3LOOP ;
4 D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC2^PSGMI(PSGDT),CML=IO'=IO(0)!($E(IOST,1,2)'="C-")
5 U IO I '$D(^TMP($J)) D G DONE
6 .W:$Y @IOF W !?26,"UNIT DOSE ACTION PROFILE #2",?62,PSGPDT,!?10,"NO ",$S(PSGAPO="E":"EXPIRING",1:"ACTIVE")," ORDERS FOUND FOR ",$S(PSGSS="G":"WARD GROUP: "_PSGAPWGN,PSGSS="W":"WARD: "_PSGAPWDN,1:"PATIENT(S) SELECTED"),"."
7 S (LN,LINE,ALN,S1,WD,PN)="",$P(LN,"_",19)="",$P(LINE,"-",81)="",$P(ALN," -",18)="",ALN=ALN_" A C T I V E"_ALN
8 S PSGVAMC=$$SITE^PSGMMAR2(80)
9 F S (PS1,S1,PSJTEAM)=$O(^TMP($J,S1)) Q:S1=""!$D(PSJDLW) S:S1="zz" (PS1,PSJTEAM)="NOT FOUND" F S WD=$O(^TMP($J,S1,WD)) Q:WD=""!$D(PSJDLW) D
10 . F S PN=$O(^TMP($J,S1,WD,PN)) Q:PN=""!$D(PSJDLW) S PI=$G(^(PN)) S:PI="" PI=$G(^TMP($J,S1,"zz",PN)) D H1
11 ;
12DONE ;PSJ*5*149 Add WD1 to killed variables.
13 W:CML&($Y) @IOF K AD,ALN,CML,DF,LINE,LN,MF,N,PG,PI,PPN,PS1,PSGPDT,RCT,RF,PID,TD,WD,PSJDLW,PSGVAMC,WD1,PSJCNTR,PSJAMO Q
14 ;
15H1 ; first header for patient
16 ; PSJ*5*149 Use WD1 to preserve value of WD
17 N WD1
18 I $G(WD)="zz" S WD1=WD N WD S WD="*NF*"
19 D ^PSGCAPP0
20 S WD=$G(WD1,WD)
21END ;
22 S (ON,DRG)="" F S DRG=$O(^TMP($J,S1,WD,PN,DRG)) Q:DRG="" F S ON=$O(^TMP($J,S1,WD,PN,DRG,ON)) Q:ON="" S ND=^(ON),SI=$G(^(ON,1)) D NP:$Y+12>IOSL Q:$D(PSJDLW) D ORDP
23 Q:$D(PSJDLW)
24 I $D(^PS(53.1,"AC",PSGP)) W !!?13,"******** THIS PATIENT HAS NON-VERIFIED ORDERS. ********"
25 S DF=1 W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE"
26 D:$Y+10>IOSL NP1 W:'$D(PSJDLW) !!!?10,"MULTIDISCIPLINARY REVIEW",!?16,"(WHEN APPROPRIATE)",?40,LN_LN,!?40,"PHARMACIST'S SIGNATURE"
27 D:$Y+6>IOSL NP1 W:'$D(PSJDLW) !!?40,LN_LN,!?40,"NURSE'S SIGNATURE"
28 ; PSJ*5*169 Standardize AMO section to 10 lines.
29 N PSJCNTR,PSJAMO
30 I IOSL-$Y>10 D
31 . W !!?3,"ADDITIONAL MEDICATION ORDERS:"
32 . F PSJCNTR=1:1:10 W !!,LINE S PSJAMO=0 I $Y+9>IOSL S PSJAMO=1 D NP1
33 I W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE",!
34 E F Q=$Y+5:1:IOSL-1 W !
35 W:'$D(PSJDLW) !?2,PPN,?40,PID,?78-$L(PDOB),PDOB Q
36 ;
37ORDP ;
38 S N=N+1 I ON["V" D PRT^PSGCAPIV(ON) Q
39 N X,PSG S PSGP=$P(PN,U,2)
40 D DRGDISP^PSJLMUT1(+PSGP,+ON_"U",39,69,.PSG,0)
41 S SM=$P(ND,"^",5),NF=$P(ND,"^",6),DCU=$P(ND,"^",7),DCU=$S($E(DCU)=".":"0"_DCU,'DCU:"0.00",1:DCU) W !,$J(N,3)
42 W ?5,PSG(1),?46,$P(DRG,"^"),?49,$P(ND,"^",2),?55,$P(ND,"^",3),?61,$P(ND,"^") I NF!SM!$P(ND,"^",4) W ?65 W:NF "NF " W:$P(ND,"^",4) "WS " W:SM $E("HSM",SM,3)
43 N X F X=1:0 S X=$O(PSG(X)) Q:'X W !?5,PSG(X)
44 I SI]"" W !?8,"Special Instructions: " F X=1:1:$L(SI," ") S Y=$P(SI," ",X) W:$X+$L(Y)>78 !?31 W Y," "
45ORDP1 ;*** Also being called from ^PSGCAPIV. PSJ*5*169 Don't allow RENEW on one-time orders.
46 W !!?5,"__TAKE NO ACTION __DISCONTINUE "_$S($P(DRG,"^")="O"!($G(QST)="O"):" ",1:"__RENEW")_" COST/DOSE: ",DCU,!?2,"------------------------------------------------------------------------",! Q
47 ;
48NP ;
49 W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE"
50 ;
51NP1 ;
52 Q:$D(PSJDLW)
53 I $E(IOST,1)="C" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDLW=1 Q
54 F Q=$Y:1:IOSL-4 W !
55 ;* S PG=PG+1 W !?2,PPN,?40,PID,?78-$L(PDOB),PDOB W:$Y @IOF W !?28,"UNIT DOSE ACTION PROFILE #2",?73-$L(PG),"Page: "_PG,!?1,PPN,?40,PID,?60,PDOB I DF W !!,LINE Q
56 S PG=PG+1 W !?2,PPN,?40,PID,?78-$L(PDOB),PDOB W:$Y @IOF
57 W !?26,"UNIT DOSE ACTION PROFILE #2",?73-$L(PG),"Page: "_PG
58 W !?+PSGVAMC,$P(PSGVAMC,U,2)
59 W !?1,PPN,?40,PID,?60,PDOB
60 I DF D Q
61 . I $G(PSJAMO)=1 W !!,"ADDITIONAL MEDICATION ORDERS (CONTINUED):",! Q
62 . W !!,LINE
63 W !!," No. Action",?16,"Drug",?46,"ST Start Stop Status/Info",!,ALN
64 Q
Note: See TracBrowser for help on using the repository browser.