source: FOIAVistA/tag/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGCAPP.m@ 636

PSGCAPP ;BIR/CML3-PRINT DATA FOR ACTION PROFILE ;05 Oct 98 / 10:21 AM
 ;;5.0; INPATIENT MEDICATIONS ;**8,20,60,111,149,169**;16 DEC 97
LOOP ;
 D NOW^%DTC S PSGDT=%,PSGPDT=$$ENDTC2^PSGMI(PSGDT),CML=IO'=IO(0)!($E(IOST,1,2)'="C-")
 U IO I '$D(^TMP($J)) D  G DONE
 .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"),"."
 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
 S PSGVAMC=$$SITE^PSGMMAR2(80)
 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
 . 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
 ;
DONE ;PSJ*5*149 Add WD1 to killed variables.
 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
 ;
H1 ; first header for patient
 ; PSJ*5*149 Use WD1 to preserve value of WD
 N WD1
 I $G(WD)="zz" S WD1=WD N WD S WD="*NF*"
 D ^PSGCAPP0
 S WD=$G(WD1,WD)
END ;
 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
 Q:$D(PSJDLW)
 I $D(^PS(53.1,"AC",PSGP)) W !!?13,"******** THIS PATIENT HAS NON-VERIFIED ORDERS. ********"
 S DF=1 W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE"
 D:$Y+10>IOSL NP1 W:'$D(PSJDLW) !!!?10,"MULTIDISCIPLINARY REVIEW",!?16,"(WHEN APPROPRIATE)",?40,LN_LN,!?40,"PHARMACIST'S SIGNATURE"
 D:$Y+6>IOSL NP1 W:'$D(PSJDLW) !!?40,LN_LN,!?40,"NURSE'S SIGNATURE"
 ; PSJ*5*169 Standardize AMO section to 10 lines.
 N PSJCNTR,PSJAMO
 I IOSL-$Y>10 D
 . W !!?3,"ADDITIONAL MEDICATION ORDERS:"
 . F PSJCNTR=1:1:10 W !!,LINE S PSJAMO=0 I $Y+9>IOSL S PSJAMO=1 D NP1
 I  W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE",!
 E  F Q=$Y+5:1:IOSL-1 W !
 W:'$D(PSJDLW) !?2,PPN,?40,PID,?78-$L(PDOB),PDOB Q
 ;
ORDP ;
 S N=N+1 I ON["V" D PRT^PSGCAPIV(ON) Q
 N X,PSG S PSGP=$P(PN,U,2)
 D DRGDISP^PSJLMUT1(+PSGP,+ON_"U",39,69,.PSG,0)
 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)
 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)
 N X F X=1:0 S X=$O(PSG(X)) Q:'X  W !?5,PSG(X)
 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," "
ORDP1 ;*** Also being called from ^PSGCAPIV.   PSJ*5*169 Don't allow RENEW on one-time orders.
 W !!?5,"__TAKE NO ACTION     __DISCONTINUE     "_$S($P(DRG,"^")="O"!($G(QST)="O"):"       ",1:"__RENEW")_"   COST/DOSE: ",DCU,!?2,"------------------------------------------------------------------------",! Q
 ;
NP ;
 W:'$D(PSJDLW) !!?16,LN,?40,LN_LN,!?16,"Date AND Time",?40,"PROVIDER'S SIGNATURE"
 ;
NP1 ;
 Q:$D(PSJDLW)
 I $E(IOST,1)="C" K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSJDLW=1 Q
 F Q=$Y:1:IOSL-4 W !
 ;* 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
 S PG=PG+1 W !?2,PPN,?40,PID,?78-$L(PDOB),PDOB W:$Y @IOF
 W !?26,"UNIT DOSE ACTION PROFILE #2",?73-$L(PG),"Page: "_PG
 W !?+PSGVAMC,$P(PSGVAMC,U,2)
 W !?1,PPN,?40,PID,?60,PDOB
 I DF D  Q
 . I $G(PSJAMO)=1 W !!,"ADDITIONAL MEDICATION ORDERS (CONTINUED):",! Q
 . W !!,LINE
 W !!," No. Action",?16,"Drug",?46,"ST Start Stop  Status/Info",!,ALN
 Q