- PSOQUAP ;HINES/RMS - UNIFIED PROFILE BASED ON PORTLAND IDEA ; 30 Nov 2007 7:57 AM
- ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
- ;
- ;Reference to BCMALG^PSJUTL2 supported by DBIA 5057
- ;Reference to CKP^GMTSUP supported by DBIA 4231
- ;Reference to COVER^ORWPS supported by DBIA 4954
- EN ;ENTRY POINT FOR HEALTH SUMMARY
- N RPC,RPCT,ALPHA,PSNUM,DRUGNM,RPCNODE,ORDER,SAVE
- D COVER^ORWPS(.RPC,DFN)
- S RPCT=0 F S RPCT=$O(RPC(RPCT)) Q:'+RPCT D ;
- . S RPCNODE=RPC(RPCT)
- . S PSNUM=$P(RPCNODE,"^")
- . S DRUGNM=$$UP^XLFSTR($P(RPCNODE,"^",2))
- . S ORDER=+$P(RPCNODE,"^",3)
- . K SAVE(DRUGNM) S SAVE(DRUGNM,ORDER,PSNUM)=""
- . Q:"ACTIVE^ACTIVE/SUSP"'[$P(RPCNODE,"^",4)
- . S ALPHA(DRUGNM,ORDER,PSNUM)=""
- D HEADER
- D OUTPUT
- D FOOTER
- Q
- D NVADT^PSOQCF04(DFN,.ATEST,.ADATE,.AVALUE,.ATEXT)
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W $$REPEAT^XLFSTR("-",IOM),!,"Alphabetical list of all prescriptions, inpatient orders and Non-VA meds"
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W !,"Legend: OPT = VA issued outpatient prescription, INP = VA issued inpatient order"
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W !,"Non-VA Meds Last Documented On: "
- W $S(+ADATE:$$FMTE^XLFDT(ADATE,"D"),1:"** Data not found **")
- D CKP^GMTSUP Q:$D(GMTSQIT)
- W !,$$REPEAT^XLFSTR("-",IOM)
- D CKP^GMTSUP Q:$D(GMTSQIT)
- Q
- OUTPUT N DRUGNM,ORDER,PSNUM
- N PACK,PACKREF,SIGLINE,ORDNUM
- N LASTACT,OTLINE
- S DRUGNM="" F S DRUGNM=$O(ALPHA(DRUGNM)) Q:DRUGNM']"" D K SAVE(DRUGNM) ;
- . S ORDER="" F S ORDER=$O(ALPHA(DRUGNM,ORDER)) Q:ORDER']"" D ;
- .. S PSNUM="" F S PSNUM=$O(ALPHA(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
- ... S PACK=$P(PSNUM,";",2),ORDNUM=$P(PSNUM,";")
- ... I PACK="I" D INPDISP
- ... I PACK="O" D OPTDISP
- Q
- N BLINE
- S BLINE=$$REPEAT^XLFSTR("-",IOM)
- W !,BLINE,!,"Other medications previously dispensed in the last year:",!
- D CKP^GMTSUP Q:$D(GMTSQIT)
- N DRUGNM,ORDER,PSNUM
- N PACK,PACKREF,SIGLINE
- S DRUGNM="" F S DRUGNM=$O(SAVE(DRUGNM)) Q:DRUGNM']"" D ;
- . S ORDER="" F S ORDER=$O(SAVE(DRUGNM,ORDER)) Q:ORDER']"" D ;
- .. S PSNUM="" F S PSNUM=$O(SAVE(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
- ... S PACK=$P(PSNUM,";",2)
- ... I PACK="O" D OPTFOOT
- Q
- S PACKREF=+$G(^OR(100,ORDER,4))
- S X1=DT,X2=-365 D C^%DTC S PSOQYEAR=X
- S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
- D CKP^GMTSUP Q:$D(GMTSQIT)
- Q:PSOQLRD<PSOQYEAR
- Q:$P(PSNUM,";")["N"
- W !,"OPT "_DRUGNM_" ("_$$GET1^DIQ(52,+PACKREF,100,"E")_"/"_$$DAYSSUPP^PSOQ0076(PACKREF)_" Days Supply Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D")_")" D CKP^GMTSUP Q:$D(GMTSQIT)
- S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
- . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
- W ! D CKP^GMTSUP Q:$D(GMTSQIT)
- Q
- INPDISP D CKP^GMTSUP Q:$D(GMTSQIT)
- W !,"INP "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
- S LASTACT=$O(^OR(100,+ORDER,8,":"),-1)
- S OTLINE=1 F S OTLINE=$O(^OR(100,+ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
- . W !?5,$$LSIG^PSOQUTIL($G(^OR(100,+ORDER,8,LASTACT,.1,OTLINE,0))) D CKP^GMTSUP Q:$D(GMTSQIT)
- . W !?5,$$BCMALG^PSJUTL2(DFN,ORDNUM) D CKP^GMTSUP Q:$D(GMTSQIT)
- W ! D CKP^GMTSUP Q:$D(GMTSQIT)
- Q
- OPTDISP N PSOQEXP,PSOQREF
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S PACKREF=+$G(^OR(100,ORDER,4))
- S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
- S PSOQEXP=$$EXPDATE^PSOQ0076(PACKREF)
- S PSOQREF=$$REFILLS^PSOQ0076(PACKREF)
- I $P(PSNUM,";")["N" G NVADISP
- W !,"OPT "_DRUGNM
- S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
- . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
- W !?15,"Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D"),?55,"Days Supply: "_$$DAYSSUPP^PSOQ0076(PACKREF) D CKP^GMTSUP Q:$D(GMTSQIT)
- W !?15,"Rx Expiration Date: ",$$FMTE^XLFDT(PSOQEXP,"2D"),?55,"Refills Remaining: ",PSOQREF D CKP^GMTSUP Q:$D(GMTSQIT)
- W ! D CKP^GMTSUP Q:$D(GMTSQIT)
- Q
- NVADISP D CKP^GMTSUP Q:$D(GMTSQIT)
- W !,"Non VA "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
- S LASTACT=$O(^OR(100,ORDER,8,":"),-1)
- S OTLINE=1 F S OTLINE=$O(^OR(100,ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
- . W !?5,$G(^OR(100,ORDER,8,LASTACT,.1,OTLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
- W ! D CKP^GMTSUP Q:$D(GMTSQIT)
- Q
- PSOQUAP ;HINES/RMS - UNIFIED PROFILE BASED ON PORTLAND IDEA ; 30 Nov 2007 7:57 AM
- +1 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
- +2 ;
- +3 ;Reference to BCMALG^PSJUTL2 supported by DBIA 5057
- +4 ;Reference to CKP^GMTSUP supported by DBIA 4231
- +5 ;Reference to COVER^ORWPS supported by DBIA 4954
- EN ;ENTRY POINT FOR HEALTH SUMMARY
- +1 NEW RPC,RPCT,ALPHA,PSNUM,DRUGNM,RPCNODE,ORDER,SAVE
- +2 DO COVER^ORWPS(.RPC,DFN)
- +3 ;
- SET RPCT=0
- FOR
- SET RPCT=$ORDER(RPC(RPCT))
- IF '+RPCT
- QUIT
- Begin DoDot:1
- +4 SET RPCNODE=RPC(RPCT)
- +5 SET PSNUM=$PIECE(RPCNODE,"^")
- +6 SET DRUGNM=$$UP^XLFSTR($PIECE(RPCNODE,"^",2))
- +7 SET ORDER=+$PIECE(RPCNODE,"^",3)
- +8 KILL SAVE(DRUGNM)
- SET SAVE(DRUGNM,ORDER,PSNUM)=""
- +9 IF "ACTIVE^ACTIVE/SUSP"'[$PIECE(RPCNODE,"^",4)
- QUIT
- +10 SET ALPHA(DRUGNM,ORDER,PSNUM)=""
- End DoDot:1
- +11 DO HEADER
- +12 DO OUTPUT
- +13 DO FOOTER
- +14 QUIT
- +1 DO NVADT^PSOQCF04(DFN,.ATEST,.ADATE,.AVALUE,.ATEXT)
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +3 WRITE $$REPEAT^XLFSTR("-",IOM),!,"Alphabetical list of all prescriptions, inpatient orders and Non-VA meds"
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 WRITE !,"Legend: OPT = VA issued outpatient prescription, INP = VA issued inpatient order"
- +6 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +7 WRITE !,"Non-VA Meds Last Documented On: "
- +8 WRITE $SELECT(+ADATE:$$FMTE^XLFDT(ADATE,"D"),1:"** Data not found **")
- +9 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +10 WRITE !,$$REPEAT^XLFSTR("-",IOM)
- +11 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +12 QUIT
- OUTPUT NEW DRUGNM,ORDER,PSNUM
- +1 NEW PACK,PACKREF,SIGLINE,ORDNUM
- +2 NEW LASTACT,OTLINE
- +3 ;
- SET DRUGNM=""
- FOR
- SET DRUGNM=$ORDER(ALPHA(DRUGNM))
- IF DRUGNM']""
- QUIT
- Begin DoDot:1
- +4 ;
- SET ORDER=""
- FOR
- SET ORDER=$ORDER(ALPHA(DRUGNM,ORDER))
- IF ORDER']""
- QUIT
- Begin DoDot:2
- +5 ;
- SET PSNUM=""
- FOR
- SET PSNUM=$ORDER(ALPHA(DRUGNM,ORDER,PSNUM))
- IF PSNUM']""
- QUIT
- Begin DoDot:3
- +6 SET PACK=$PIECE(PSNUM,";",2)
- SET ORDNUM=$PIECE(PSNUM,";")
- +7 IF PACK="I"
- DO INPDISP
- +8 IF PACK="O"
- DO OPTDISP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- KILL SAVE(DRUGNM)
- +9 QUIT
- IF $DATA(GMTSQIT)
- QUIT
- +1 NEW BLINE
- +2 SET BLINE=$$REPEAT^XLFSTR("-",IOM)
- +3 WRITE !,BLINE,!,"Other medications previously dispensed in the last year:",!
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 NEW DRUGNM,ORDER,PSNUM
- +6 NEW PACK,PACKREF,SIGLINE
- +7 ;
- SET DRUGNM=""
- FOR
- SET DRUGNM=$ORDER(SAVE(DRUGNM))
- IF DRUGNM']""
- QUIT
- Begin DoDot:1
- +8 ;
- SET ORDER=""
- FOR
- SET ORDER=$ORDER(SAVE(DRUGNM,ORDER))
- IF ORDER']""
- QUIT
- Begin DoDot:2
- +9 ;
- SET PSNUM=""
- FOR
- SET PSNUM=$ORDER(SAVE(DRUGNM,ORDER,PSNUM))
- IF PSNUM']""
- QUIT
- Begin DoDot:3
- +10 SET PACK=$PIECE(PSNUM,";",2)
- +11 IF PACK="O"
- DO OPTFOOT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +1 SET PACKREF=+$GET(^OR(100,ORDER,4))
- +2 SET X1=DT
- SET X2=-365
- DO C^%DTC
- SET PSOQYEAR=X
- +3 SET PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 IF PSOQLRD<PSOQYEAR
- QUIT
- +6 IF $PIECE(PSNUM,";")["N"
- QUIT
- +7 WRITE !,"OPT "_DRUGNM_" ("_$$GET1^DIQ(52,+PACKREF,100,"E")_"/"_$$DAYSSUPP^PSOQ0076(PACKREF)_" Days Supply Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D")_")"
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +8 ;
- SET SIGLINE=0
- FOR
- SET SIGLINE=$ORDER(^PSRX(PACKREF,"SIG1",SIGLINE))
- IF '+SIGLINE
- QUIT
- Begin DoDot:1
- +9 WRITE !?5,$GET(^PSRX(PACKREF,"SIG1",SIGLINE,0))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +10 WRITE !
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +11 QUIT
- INPDISP DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +1 WRITE !,"INP "_DRUGNM
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +2 SET LASTACT=$ORDER(^OR(100,+ORDER,8,":"),-1)
- +3 ;
- SET OTLINE=1
- FOR
- SET OTLINE=$ORDER(^OR(100,+ORDER,8,LASTACT,.1,OTLINE))
- IF '+OTLINE
- QUIT
- Begin DoDot:1
- +4 WRITE !?5,$$LSIG^PSOQUTIL($GET(^OR(100,+ORDER,8,LASTACT,.1,OTLINE,0)))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 WRITE !?5,$$BCMALG^PSJUTL2(DFN,ORDNUM)
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +6 WRITE !
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +7 QUIT
- OPTDISP NEW PSOQEXP,PSOQREF
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +2 SET PACKREF=+$GET(^OR(100,ORDER,4))
- +3 SET PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
- +4 SET PSOQEXP=$$EXPDATE^PSOQ0076(PACKREF)
- +5 SET PSOQREF=$$REFILLS^PSOQ0076(PACKREF)
- +6 IF $PIECE(PSNUM,";")["N"
- GOTO NVADISP
- +7 WRITE !,"OPT "_DRUGNM
- +8 ;
- SET SIGLINE=0
- FOR
- SET SIGLINE=$ORDER(^PSRX(PACKREF,"SIG1",SIGLINE))
- IF '+SIGLINE
- QUIT
- Begin DoDot:1
- +9 WRITE !?5,$GET(^PSRX(PACKREF,"SIG1",SIGLINE,0))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +10 WRITE !?15,"Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D"),?55,"Days Supply: "_$$DAYSSUPP^PSOQ0076(PACKREF)
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +11 WRITE !?15,"Rx Expiration Date: ",$$FMTE^XLFDT(PSOQEXP,"2D"),?55,"Refills Remaining: ",PSOQREF
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +12 WRITE !
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +13 QUIT
- NVADISP DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +1 WRITE !,"Non VA "_DRUGNM
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +2 SET LASTACT=$ORDER(^OR(100,ORDER,8,":"),-1)
- +3 ;
- SET OTLINE=1
- FOR
- SET OTLINE=$ORDER(^OR(100,ORDER,8,LASTACT,.1,OTLINE))
- IF '+OTLINE
- QUIT
- Begin DoDot:1
- +4 WRITE !?5,$GET(^OR(100,ORDER,8,LASTACT,.1,OTLINE,0))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- +5 WRITE !
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +6 QUIT
