PSOQMCAL	; SEA/HAM3 PMI - PHARMACY MEDICATION INSTRUCTION ; 30 Nov 2007  7:55 AM
	;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
	;
	;Reference to CKP^GMTSUP supported by DBIA 4231
	;Reference to COVER^ORWPS supported by DBIA 4954
	;Credit to Herb Morriss and Al Hernandez for the original design
	;Puget Sound Health Care System, Seattle WA
EN	N PSOQPEND,DAYSEP,DRUGHDR1,DRUGHDR2,DRUGSEP,INSTSEP1,INSTSEP2,INSTSEP3
	N EMPTYLN,PRETYPE,SUPTYPE,ADDR,AL,ALFLAG,ARLDASH
	N ARLDATE,ARLDFN,ARLDOB,ARLNAME,ARLSITE,ARLSN
	N BLANKLN,BLNKLN,DRUG1,FOOD,GMRAL,IDRUG,ISIG,ITYPE
	N NVA,NONE,PAGE,PGWIDTH,PGLENGTH,PHONE
	N RXIEN,SIGCNT,SIGPOS,XPOS1,XPOS2,XPOS3,XPOS4
	N FN,HP,IA,RPTDATE,TYPE,WP,ST,SUPCNT,SUPDRUG,X,X1,X2,ADDRFL
	N DIWF,DIWL,DIWR,INSTSEP1,INSTSEP2,INSTSEP3,DRUGHDR1,DRUGHDR2,DRUGSEP
	S PGWIDTH=IOM-5,PGLENGTH=IOSL-9
	Q:PGWIDTH<48  ;ensure that the IOM variable is wide enough
	S RPTDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
	S XPOS1=(PGWIDTH-26)\2  ;title
	S XPOS2=PGWIDTH-6       ;page number
	S XPOS3=(PGWIDTH-29)\2  ;site
	S XPOS4=(PGWIDTH-53)\2  ;refill info
	S BLANKLN="",$P(BLNKLN," ",PGWIDTH)=" "
	S EMPTYLN="!,""|"_$E(BLNKLN,1,PGWIDTH-2)_"|"""
	S DAYSEP="|       |       |       |       |"
	S DRUGHDR1="|                 |MORNING| NOON  |EVENING|BEDTIME|       COMMENTS"
	S DRUGHDR1=DRUGHDR1_$E(BLNKLN,$L(DRUGHDR1),PGWIDTH-2)_"|"
	S DRUGHDR2="|                 "_DAYSEP
	S DRUGHDR2=DRUGHDR2_$E(BLNKLN,$L(DRUGHDR2),PGWIDTH-2)_"|"
	S $P(DRUGSEP,"~",PGWIDTH-2)="~"
	S DRUGSEP="|"_DRUGSEP_"|"
	S $P(INSTSEP1,"-",PGWIDTH-2)="-"
	S INSTSEP1="|"_INSTSEP1_"|"
	S INSTSEP2="| UNITS PER DOSE: "_DAYSEP
	S INSTSEP2=INSTSEP2_$E(BLNKLN,$L(INSTSEP2),PGWIDTH-2)_"|"
	S INSTSEP3="|                 "_DAYSEP
	S INSTSEP3=INSTSEP3_$E(BLNKLN,$L(INSTSEP3),PGWIDTH-2)_"|"
	S X1=DT,X2=-45 D C^%DTC S ARLDATE=X
1	;Patient
	S ARLDFN=""
	F IA=1:1 S ARLDFN=$P(ARLPAT,";",IA) Q:ARLDFN=""  D
	. S PAGE=1
	. D HD,SHOW(ARLDFN)
	Q
SHOW(PTIEN)	;
	N LIST,NVA
	D COVER^ORWPS(.LIST,PTIEN)
	D GETOPORD(.LIST)
	D GETRXDAT(.LIST)
	S SUPTYPE=0,PRETYPE="D"
	S ITYPE="@"
	F  S ITYPE=$O(LIST(ITYPE)) Q:ITYPE]"ZZZ"  Q:ITYPE=""  D
	. I PRETYPE'=ITYPE D
	. . W !,DRUGSEP
	. . W @EMPTYLN
	. . W !,"|","SUPPLY ITEMS:"_$E(BLNKLN,14,PGWIDTH-2)_"|"
	. . S PRETYPE=ITYPE
	. . I (ITYPE="S")&(SUPTYPE=0) D
	. . . S SUPTYPE=1,SUPCNT=0,SUPDRUG=""
	. . . F  S SUPDRUG=$O(LIST(ITYPE,SUPDRUG)) Q:SUPDRUG=""  D
	. . . . S SUPCNT=SUPCNT+1
	. . . I $Y>(PGLENGTH-SUPCNT) W !,DRUGSEP,@IOF D HD3
	. S IDRUG=""
	. F  S IDRUG=$O(LIST(ITYPE,IDRUG)) Q:IDRUG=""  D
	. . I 'SUPTYPE D
	. . S SIGCNT=0,SIGPOS=""
	. . F  S SIGPOS=$O(LIST(ITYPE,IDRUG,SIGPOS)) Q:SIGPOS=""  D
	. . . S SIGCNT=SIGCNT+1
	. . I $Y>(PGLENGTH-SIGCNT) W !,DRUGSEP,@IOF D HD3
	. . W:'SUPTYPE !,DRUGSEP,@EMPTYLN
	. . W !,"|",IDRUG_$E(BLNKLN,$L(IDRUG),PGWIDTH-3)_"|"
	. . Q:SUPTYPE
	. . S ISIG=0
	. . F  S ISIG=$O(LIST(ITYPE,IDRUG,ISIG)) Q:ISIG<1  D
	. . . W !,"|     ",LIST(ITYPE,IDRUG,ISIG),$E(BLNKLN,$L(LIST(ITYPE,IDRUG,ISIG)),PGWIDTH-8),"|"
	. . W !,INSTSEP1,!,INSTSEP2 W:'$G(PSOQHS) !,INSTSEP3
NVA	;NVA MEDS ADDED 5/6/05
	I $D(NVA) D
	. N NVACNT,NVADRUG
	. W !,DRUGSEP
	. W @EMPTYLN
	. W !,"|","NON-VA Medications:"_$E(BLNKLN,20,PGWIDTH-2)_"|"
	. W @EMPTYLN
	. S NVACNT=0
	. S NVADRUG=""
	. F  S NVADRUG=$O(NVA(NVADRUG)) Q:NVADRUG=""  D
	. . S NVACNT=NVACNT+1
	. . I $Y>(PGLENGTH-NVACNT) W !,DRUGSEP,@IOF D HD3
	. . W !,"|",NVADRUG_$E(BLNKLN,$L(NVADRUG),PGWIDTH-3)_"|"
	K NVACNT,NVADRUG
	W !,INSTSEP1
	D
	. Q:'$G(PSOQPEND)
	. W !!,"Any medication items listed as ""pending"" are those that have just been" D PGE Q:$D(GMTSQIT)
	. W !,"written by your provider(s).  These medication orders will be reviewed" D PGE Q:$D(GMTSQIT)
	. W !,"by your pharmacist, prior to the prescription(s) being dispensed.  When" D PGE Q:$D(GMTSQIT)
	. W !,"you receive your new prescription(s), by mail or from the pharmacy window," D PGE Q:$D(GMTSQIT)
	. W !,"be sure to follow the instructions on the prescription label.  If you" D PGE Q:$D(GMTSQIT)
	. W !,"have any question about your medication, please call your provider or " D PGE Q:$D(GMTSQIT)
	. W !,"your pharmacist." D PGE Q:$D(GMTSQIT)
	Q
PGE	D:$G(PSOQHS) CKP^GMTSUP
	Q
GETOPORD(ORDLIST)	;
	N LISTIEN,KILLORD
	S LISTIEN=0
	F  S LISTIEN=$O(ORDLIST(LISTIEN)) Q:LISTIEN<1  D
	. S KILLORD=$$IPORD(ORDLIST(LISTIEN))
	. I 'KILLORD S KILLORD=$$CKSTATUS(ORDLIST(LISTIEN)) D
	. K:KILLORD ORDLIST(LISTIEN)
	Q
IPORD(LISTNODE)	;
	N RETURN,PKG
	S RETURN=0
	S PKG=$P($P(LISTNODE,"^",1),";",2)
	I "UI"[PKG S RETURN=1
	I $P(LISTNODE,"^",1)["N;" D
	. S:$P(LISTNODE,"^",4)="ACTIVE" NVA($P(LISTNODE,"^",2),+LISTNODE)=LISTNODE
	. S RETURN=1
	Q RETURN
CKSTATUS(LISTNODE)	;
	N RETURN,RXIEN
	S RETURN=0 ; ASSUME ACTIVE AND NOT PASS MED
	S:$P(LISTNODE,"^",4)["DISCONTINUED" RETURN=1
	S:$P(LISTNODE,"^",4)["EXPIRED" RETURN=1
	Q RETURN
GETRXDAT(RXS)	;
	N RXSIEN,DRUGNAME,FSIG,RXTYPE
	S RXSIEN=0
	F  S RXSIEN=$O(RXS(RXSIEN)) Q:RXSIEN<1  D
	. I $P(RXS(RXSIEN),";")["P" D GETPEND(RXSIEN) S PSOQPEND=1 Q  ;-> 
	. S RXIEN=+RXS(RXSIEN)
	. S DRUGNAME=$$ZZ^PSOSUTL(RXIEN)
	. D FSIG^PSOUTLA("R",RXIEN,PGWIDTH-8)
	. S RXTYPE=$$GETTYPE(RXIEN)
	. M RXS(RXTYPE,DRUGNAME)=FSIG
	. N PSOQSUB
	. S PSOQSUB=$O(RXS(RXTYPE,DRUGNAME,":"),-1)+1
	. S RXS(RXTYPE,DRUGNAME,PSOQSUB)=$$REFILLS^PSOQ0076(RXIEN)_" refill(s) remaining prior to "_$$FMTE^XLFDT($$EXPDATE^PSOQ0076(RXIEN))
	Q
GETPEND(RXSIEN)	;RMS/HINES 8-16-07 ADD PENDING RX'S
	N PSOQPDN,PSOQDIND,PSOQOIND,PSOQ100,PSOQSIND,PSOQSCT,PSOQRAW,SUB
	S PSOQ100=$P(RXS(RXSIEN),U,3) Q:'+PSOQ100
	S PSOQOIND=$O(^OR(100,PSOQ100,4.5,"ID","ORDERABLE",0)) Q:'+PSOQOIND
	S PSOQPDN=$P($G(^ORD(101.43,+$G(^OR(100,PSOQ100,4.5,PSOQOIND,1)),0)),U)
	S PSOQDIND=$O(^OR(100,PSOQ100,4.5,"ID","DRUG",0)) D
	. Q:'+PSOQDIND
	. S PSOQPDN=$P($G(^PSDRUG(+$G(^OR(100,PSOQ100,4.5,PSOQDIND,1)),0)),U)
	S PSOQSIND=$O(^OR(100,PSOQ100,8,":"),-1) Q:'+PSOQSIND
	F PSOQSCT=2:1:$O(^OR(100,PSOQ100,8,PSOQSIND,.1,":"),-1) D
	. S PSOQRAW=$G(^OR(100,PSOQ100,8,PSOQSIND,.1,PSOQSCT,0))
	. N WORDS,COUNT,LINE,NEXTWORD
	. S WORDS=$L(PSOQRAW," "),SUB=$G(SUB,0)+1
	. F COUNT=1:1:WORDS D
	.. S NEXTWORD=$P(PSOQRAW," ",COUNT)
	.. Q:NEXTWORD=""
	.. S LINE=$G(LINE)_NEXTWORD_" "
	.. I $L($G(LINE))>65&(COUNT'=WORDS) K LINE S SUB=SUB+1
	.. S RXS("D","**PENDING**"_PSOQPDN,SUB)=$G(RXS("D","**PENDING**"_PSOQPDN,SUB))_NEXTWORD_" "
	Q
GETTYPE(IEN52)	;
	N RETURN,CLASS
	S RETURN="D"
	S CLASS=$$GETCLASS(IEN52)
	S:$E(CLASS,1,1)="X" RETURN="S"
	S:$E(CLASS,1,2)="DX" RETURN="S"
	Q RETURN
GETCLASS(IENRX)	;
	N RETURN,NODE0RX,IENDRUG,NODE0DRG,NODEND50,IENCLASS,NODE0CLS,VACLASS
	S RETURN=""
	S NODE0RX=$G(^PSRX(IENRX,0))
	S IENDRUG=$P(NODE0RX,"^",6)
	Q:+IENDRUG=0 RETURN
	S NODE0DRG=$G(^PSDRUG(IENDRUG,0))
	S NODEND50=$G(^PSDRUG(IENDRUG,"ND"))
	S IENCLASS=$P(NODEND50,"^",6)
	Q:+IENCLASS=0 RETURN
	S NODE0CLS=$G(^PS(50.605,IENCLASS,0))
	S VACLASS=$P(NODE0CLS,"^",1)
	S RETURN=VACLASS
	Q RETURN
HD	;
	S FN=ARLDFN
	S ARLNAME=$E($P(^DPT(ARLDFN,0),"^",1),1,28)
	S ARLSN=$P(^(0),"^",9),ARLDOB=$P(^(0),"^",3)
	S PHONE=$S($D(^DPT(ARLDFN,.13)):^(.13),1:"")
	S HP=$P(PHONE,"^",1),WP=$P(PHONE,"^",2)
	S ADDR=$S($D(^DPT(ARLDFN,.11)):^(.11),1:"")
	I $D(^DPT(ARLDFN,.121)),$P(^(.121),"^",9)="Y" D
	. S X=$S($P(^(.121),"^",8):$P(^(.121),"^",8),1:9999999)
	. I DT'<$P(^(.121),"^",7),DT'>X D
	. . S ADDR=^(.121)
	. . S ADDRFL="(temporary)"
	. . S HP=$P(ADDR,"^",10)
	S ST=$S($D(^DIC(5,+$P(ADDR,"^",5),0)):$P(^(0),"^",2),1:"UNKNOWN")
	S ADDR(4)=$P(ADDR,"^",4)_", "_ST_"  "_$P(ADDR,"^",6)
	S ADDR(3)=$P(ADDR,"^",3),ADDR(2)=$P(ADDR,"^",2),ADDR(1)=$P(ADDR,"^",1)
	I ADDR(2)']"" D
	. S ADDR(2)=ADDR(3)
	. S ADDR(3)=""
HD1	; Header for 1st page
	S ARLSITE=^PS(59,PSOSITE,0)
	D PGE Q:$D(GMTSQIT)
	W !,"Date: ",RPTDATE,?XPOS1,"PATIENT MEDICATION INFORMATION"
	I $D(PAGE) D
	. W ?XPOS2,"Page: ",PAGE
	. S PAGE=PAGE+1
	W !,?XPOS4,"PRINTED BY THE VA MEDICAL CENTER AT: "_$P($G(^DIC(4,+$G(^PS(59,PSOSITE,"INI")),0)),U,1)
	W !,?XPOS4,"FOR PRESCRIPTION REFILLS CALL ("_$P(ARLSITE,U,3)_") "_$P(ARLSITE,U,4)
HD2	W !!,"Name: ",$E(ARLNAME,1,40)," - ",$E(ARLSN,6,9)
	W ?30," PHARMACY - ",$P(ARLSITE,"^",7)," DIVISION (",$P(ARLSITE,"^",3),"-",$P(ARLSITE,"^",4),")",!
	W !,INSTSEP1,!,DRUGHDR1 ;!,DRUGHDR2
	Q
HD3	;Header for subsequent pages
	W !,"Date: ",RPTDATE,?XPOS1,"PATIENT MEDICATION INFORMATION"
	I $D(PAGE) W ?XPOS2,"Page: ",PAGE S PAGE=PAGE+1
	W !,?XPOS4,"PRINTED BY THE VA MEDICAL CENTER AT: "_$P($G(^DIC(4,+$G(^PS(59,PSOSITE,"INI")),0)),U,1)
	W !,?XPOS4,"FOR PRESCRIPTION REFILLS CALL ("_$P(ARLSITE,U,3)_") "_$P(ARLSITE,U,4),!
	W !?1,"Name: ",$E(ARLNAME,1,40)," - ",$E(ARLSN,6,9)
	W ?30," PHARMACY - ",$P(ARLSITE,"^",7)," DIVISION (",$P(ARLSITE,"^",3),"-",$P(ARLSITE,"^",4),")",!
	W !,INSTSEP1
	W:$G(SUPCNT)&'$G(NVACNT) !,"|","SUPPLY ITEMS:"_$E(BLNKLN,14,PGWIDTH-2)_"|",@EMPTYLN
	W:$G(NVACNT) @EMPTYLN,!,"|","NON-VA Medications:"_$E(BLNKLN,20,PGWIDTH-2)_"|",@EMPTYLN
	W:'$G(NVACNT)&'$G(SUPCNT) !,DRUGHDR1
	Q
RE	;Allergies
	S ARLDASH="",$P(ARLDASH,"=",$E(BLNKLN,1,PGWIDTH-10))=ARLDASH W !,ARLDASH,!!
	S NONE="NO INFORMATION (COMPLETE SECTION BELOW)",ALFLAG=0 D ALL
	W "REACTIONS/ALLERGIES currently on file : ",$S($D(GMRAL):"",1:NONE) Q:'$D(GMRAL)
	S X=DRUG1_FOOD,DIWL=5,DIWR=PGWIDTH-5,DIWF="W" D ^DIWP,^DIWW
	Q
ALL	;Gets allergy info
	K GMRA,GMRAL
	N IFN,DATA,VER,ARLEND
	S ARLEND=0,DFN=ARLDFN,GMRA="0^0^011" D ^GMRADPT S (DRUG1,FOOD)=""
	I $D(GMRAL),GMRAL=0 S DRUG1="NO KNOWN ALLERGIES"
	I $D(GMRAL),GMRAL=1 S IFN="" F  S IFN=$O(GMRAL(IFN)) Q:IFN=""!(ARLEND)  S DATA=GMRAL(IFN),AL=$P(DATA,U,2),TYPE=$P(DATA,U,3),VER=$S($P(DATA,U,4)=1:"V",1:"NV") D
	.I $L(DRUG1)>300 S DRUG1="TOO MANY TO LIST",ARLEND=1
	.S:TYPE="D" DRUG1=AL_" ("_VER_"),"_DRUG1
	.S:TYPE="F" FOOD="Food Allergies on File"
	Q