PSORMRXP ;BIRM/JAM - REMOTE DATA INTEROPERABILITY REPORT ; 12/05/08
;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
;;
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
EN(PSODFN) ;- Remote medication entry point
N PSONAM,PSODOB
; - get remote data if available.
I '$$RDI^PSORMRX(PSODFN) Q
; Get Patient data
S PSONAM=$$GET1^DIQ(2,PSODFN,.01)
S PSODOB=$$FMTE^XLFDT($$GET1^DIQ(2,PSODFN,.03),"5ZM")
D PRINT
;
EXIT ; kill variables before existing...
K ^TMP($J,"PSORDI")
Q
;
PRINT ;Print remote medication data
N LC,DATA,QTY,ISDT,LFDT,FSIG,SIG,SITE,SITEO,STA,EXPDT,PSQFLG
S (LC,PSQFLG)=0,SITEO=""
F S LC=$O(^TMP($J,"PSORDI",PSODFN,LC)) Q:'LC D I PSQFLG Q
.S DATA=$G(^TMP($J,"PSORDI",PSODFN,LC,0))
.S EXPDT=$P(DATA,"^",7),STA=$P(DATA,"^",5)
.S STA=$$STACHK^PSORMRX(STA,EXPDT) I '+STA Q
.S STA=$P(STA,"^",2)
.S SITE=$P(DATA,"^") I SITE'=SITEO D HEADER I PSQFLG Q
.S QTY=$P($P(DATA,"^",6),";")
.S ISDT=$P(DATA,"^",8),LFDT=$P(DATA,"^",9)
.W !,$E($P(DATA,"^",4),1,13),?15,$E($P(DATA,"^",2),1,35)
.W ?50,$S(STA="DISCONTINUED":"DC",1:$E(STA)),?53,$J(QTY,4)
.W ?59,$$FMTE^XLFDT(ISDT,"5ZM"),?70,$$FMTE^XLFDT(LFDT,"5ZM"),!
.I ($Y+5)>IOSL D HEADER I PSQFLG Q
.S SITEO=SITE
.I $D(^TMP($J,"PSORDI",PSODFN,LC,"SIG")) D
..K FSIG D GETSIG
..W ?15,"SIG: " S SIG=0
..F S SIG=$O(FSIG(SIG)) Q:'SIG D
...W ?20,FSIG(SIG),!
...I ($Y+5)>IOSL D HEADER I PSQFLG Q
.W ?15,"PROVIDER: "_$P(DATA,"^",11),!
Q
;
GETSIG ;Get SIG for remote sites from ^TMP($J,"PSORDI",
N RSIG,I
F I=0:1 Q:'$D(^TMP($J,"PSORDI",PSODFN,LC,"SIG",I)) S RSIG(I+1)=^(I)
I $O(RSIG(""))'="" D FMTSIG^PSORMRX
Q
;
I SITEO="" D HDR Q
I ($Y+5)>IOSL D:$E(IOST,1,2)="C-" EOP D HDR Q:PSQFLG D HDR1 Q
I SITE'=SITEO W !,SITE,!
Q
EOP ; prints to end of page
N XX,DIR,X,Y
I $E(IOST,1,2)="C-" D
.F XX=1:1:(21-$Y) W !
.S DIR(0)="E" D ^DIR I 'Y S PSQFLG=1
Q
;
HDR ; report header
N I
W @IOF
W ?21,"MEDICATION PROFILE FROM OTHER VAMC(s)"
W ?68,"Page: ",$G(PAGE,1),!
W ?28,"Date Printed: "_$$FMTE^XLFDT(DT,"5ZM"),!
W !,"Patient: "_PSONAM,?60,"DOB: ",PSODOB
W ! F I=1:1:79 W "="
W !!
W ?3,"RX #",?15,"DRUG",?50,"ST",?54,"QTY",?59,"ISSUED",?68,"LAST FILLED"
W ! F I=1:1:79 W "="
W !,SITE,!
S PAGE=$G(PAGE,1)+1
Q
;
HDR1 ;Print partial header
I SITEO="" Q
W $E($P(DATA,"^",4),1,13),?15,$E($P(DATA,"^",2),1,35)," Cont'd",!
Q
PSORMRXP ;BIRM/JAM - REMOTE DATA INTEROPERABILITY REPORT ; 12/05/08
+1 ;;7.0;OUTPATIENT PHARMACY;**320**;DEC 1997;Build 2
+2 ;;
+3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+4 ;
+5 ;
EN(PSODFN) ;- Remote medication entry point
+1 NEW PSONAM,PSODOB
+2 ; - get remote data if available.
+3 IF '$$RDI^PSORMRX(PSODFN)
QUIT
+4 ; Get Patient data
+5 SET PSONAM=$$GET1^DIQ(2,PSODFN,.01)
+6 SET PSODOB=$$FMTE^XLFDT($$GET1^DIQ(2,PSODFN,.03),"5ZM")
+7 DO PRINT
+8 ;
EXIT ; kill variables before existing...
+1 KILL ^TMP($JOB,"PSORDI")
+2 QUIT
+3 ;
PRINT ;Print remote medication data
+1 NEW LC,DATA,QTY,ISDT,LFDT,FSIG,SIG,SITE,SITEO,STA,EXPDT,PSQFLG
+2 SET (LC,PSQFLG)=0
SET SITEO=""
+3 FOR
SET LC=$ORDER(^TMP($JOB,"PSORDI",PSODFN,LC))
IF 'LC
QUIT
Begin DoDot:1
+4 SET DATA=$GET(^TMP($JOB,"PSORDI",PSODFN,LC,0))
+5 SET EXPDT=$PIECE(DATA,"^",7)
SET STA=$PIECE(DATA,"^",5)
+6 SET STA=$$STACHK^PSORMRX(STA,EXPDT)
IF '+STA
QUIT
+7 SET STA=$PIECE(STA,"^",2)
+8 SET SITE=$PIECE(DATA,"^")
IF SITE'=SITEO
DO HEADER
IF PSQFLG
QUIT
+9 SET QTY=$PIECE($PIECE(DATA,"^",6),";")
+10 SET ISDT=$PIECE(DATA,"^",8)
SET LFDT=$PIECE(DATA,"^",9)
+11 WRITE !,$EXTRACT($PIECE(DATA,"^",4),1,13),?15,$EXTRACT($PIECE(DATA,"^",2),1,35)
+12 WRITE ?50,$SELECT(STA="DISCONTINUED":"DC",1:$EXTRACT(STA)),?53,$JUSTIFY(QTY,4)
+13 WRITE ?59,$$FMTE^XLFDT(ISDT,"5ZM"),?70,$$FMTE^XLFDT(LFDT,"5ZM"),!
+14 IF ($Y+5)>IOSL
DO HEADER
IF PSQFLG
QUIT
+15 SET SITEO=SITE
+16 IF $DATA(^TMP($JOB,"PSORDI",PSODFN,LC,"SIG"))
Begin DoDot:2
+17 KILL FSIG
DO GETSIG
+18 WRITE ?15,"SIG: "
SET SIG=0
+19 FOR
SET SIG=$ORDER(FSIG(SIG))
IF 'SIG
QUIT
Begin DoDot:3
+20 WRITE ?20,FSIG(SIG),!
+21 IF ($Y+5)>IOSL
DO HEADER
IF PSQFLG
QUIT
End DoDot:3
End DoDot:2
+22 WRITE ?15,"PROVIDER: "_$PIECE(DATA,"^",11),!
End DoDot:1
IF PSQFLG
QUIT
+23 QUIT
+24 ;
GETSIG ;Get SIG for remote sites from ^TMP($J,"PSORDI",
+1 NEW RSIG,I
+2 FOR I=0:1
IF '$DATA(^TMP($JOB,"PSORDI",PSODFN,LC,"SIG",I))
QUIT
SET RSIG(I+1)=^(I)
+3 IF $ORDER(RSIG(""))'=""
DO FMTSIG^PSORMRX
+4 QUIT
+5 ;
+1 IF SITEO=""
DO HDR
QUIT
+2 IF ($Y+5)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
DO EOP
DO HDR
IF PSQFLG
QUIT
DO HDR1
QUIT
+3 IF SITE'=SITEO
WRITE !,SITE,!
+4 QUIT
EOP ; prints to end of page
+1 NEW XX,DIR,X,Y
+2 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:1
+3 FOR XX=1:1:(21-$Y)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
IF 'Y
SET PSQFLG=1
End DoDot:1
+5 QUIT
+6 ;
HDR ; report header
+1 NEW I
+2 WRITE @IOF
+3 WRITE ?21,"MEDICATION PROFILE FROM OTHER VAMC(s)"
+4 WRITE ?68,"Page: ",$GET(PAGE,1),!
+5 WRITE ?28,"Date Printed: "_$$FMTE^XLFDT(DT,"5ZM"),!
+6 WRITE !,"Patient: "_PSONAM,?60,"DOB: ",PSODOB
+7 WRITE !
FOR I=1:1:79
WRITE "="
+8 WRITE !!
+9 WRITE ?3,"RX #",?15,"DRUG",?50,"ST",?54,"QTY",?59,"ISSUED",?68,"LAST FILLED"
+10 WRITE !
FOR I=1:1:79
WRITE "="
+11 WRITE !,SITE,!
+12 SET PAGE=$GET(PAGE,1)+1
+13 QUIT
+14 ;
HDR1 ;Print partial header
+1 IF SITEO=""
QUIT
+2 WRITE $EXTRACT($PIECE(DATA,"^",4),1,13),?15,$EXTRACT($PIECE(DATA,"^",2),1,35)," Cont'd",!
+3 QUIT
