- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORMRXP 2482 printed Feb 19, 2025@00:00:30 Page 2
- 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
