PSOCPVW ;BHAMISC/JrR - SCREEN PROFILE FOR INT BILLING ; 06/09/92
;;7.0;OUTPATIENT PHARMACY;;DEC 1997
;Requires X = "RXN^fill #" e.g. X="3007^2" means second refill
;of RX in ^PSRX(3007, . "3007^0" would mean original fill.
Q
EN ;Enter here from IB package to begin screen profile
G:$S('$D(X):1,'$P(X,"^"):1,$P(X,"^",2)="":1,1:0) EXIT
S PSORXN=$P(X,"^")
S PSOFILL=$P(X,"^",2)
S PSORX0=$G(^PSRX(PSORXN,0))
G:PSORX0="" EXIT
S PSORX1=$G(^PSRX(PSORXN,1,PSOFILL,0))
G:PSOFILL&(PSORX1="") EXIT
DIQ S DIC="^PSRX(",DR=".01;2;4;6;7;8;22"
S DIQ="PSOTMP",DIQ(0)="E",DA=PSORXN
D EN^DIQ1
I PSORX1]"" S DIQ="PSOTMP",DIQ(0)="E",DA=PSOFILL,DA(1)=PSORXN,DIC="^PSRX("_PSORXN_",1,",DR=.01 D EN^DIQ1
N DFN,VA
S DFN=$P(PSORX0,"^",2)
D PID^VADPT
D TALK
EXIT K PSORXN,PSOFILL,PSORX0,PSORX1,X,D0,DA,DIC,DIQ,DR,VA,VAERR
Q
TALK ; - if $d(psontalk) return variables, else write
I $D(PSONTALK) Q
W !," RX#: ",$S($D(PSOTMP(52,PSORXN,.01,"E")):PSOTMP(52,PSORXN,.01,"E"),1:"Not Available")
W ?19,"FILL DATE: ",$S($D(PSOTMP(52,PSORXN,22,"E")):PSOTMP(52,PSORXN,22,"E"),1:"Not Available")
W ?48,"PHYSICIAN: ",$S($D(PSOTMP(52,PSORXN,4,"E")):PSOTMP(52,PSORXN,4,"E"),1:"Not Available")
W !,"DRUG: ",$S($D(PSOTMP(52,PSORXN,6,"E")):PSOTMP(52,PSORXN,6,"E"),1:"Not Available")
W ?47,"QTY: ",$S($D(PSOTMP(52,PSORXN,7,"E")):$J(PSOTMP(52,PSORXN,7,"E"),4),1:"Not Available")
W ?66,"DAYS SUP: ",$S($D(PSOTMP(52,PSORXN,8,"E")):PSOTMP(52,PSORXN,8,"E"),1:"Not Available")
I PSOFILL W !,?17,"REFILL DATE: ",$S($D(PSOTMP(52.1,PSOFILL,.01,"E")):PSOTMP(52.1,PSOFILL,.01,"E"),1:"Not Available")
K PSOTMP Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCPVW 1614 printed Oct 16, 2024@18:26:44 Page 2
PSOCPVW ;BHAMISC/JrR - SCREEN PROFILE FOR INT BILLING ; 06/09/92
+1 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
+2 ;Requires X = "RXN^fill #" e.g. X="3007^2" means second refill
+3 ;of RX in ^PSRX(3007, . "3007^0" would mean original fill.
+4 QUIT
EN ;Enter here from IB package to begin screen profile
+1 if $SELECT('$DATA(X)
GOTO EXIT
+2 SET PSORXN=$PIECE(X,"^")
+3 SET PSOFILL=$PIECE(X,"^",2)
+4 SET PSORX0=$GET(^PSRX(PSORXN,0))
+5 if PSORX0=""
GOTO EXIT
+6 SET PSORX1=$GET(^PSRX(PSORXN,1,PSOFILL,0))
+7 if PSOFILL&(PSORX1="")
GOTO EXIT
DIQ SET DIC="^PSRX("
SET DR=".01;2;4;6;7;8;22"
+1 SET DIQ="PSOTMP"
SET DIQ(0)="E"
SET DA=PSORXN
+2 DO EN^DIQ1
+3 IF PSORX1]""
SET DIQ="PSOTMP"
SET DIQ(0)="E"
SET DA=PSOFILL
SET DA(1)=PSORXN
SET DIC="^PSRX("_PSORXN_",1,"
SET DR=.01
DO EN^DIQ1
+4 NEW DFN,VA
+5 SET DFN=$PIECE(PSORX0,"^",2)
+6 DO PID^VADPT
+7 DO TALK
EXIT KILL PSORXN,PSOFILL,PSORX0,PSORX1,X,D0,DA,DIC,DIQ,DR,VA,VAERR
+1 QUIT
TALK ; - if $d(psontalk) return variables, else write
+1 IF $DATA(PSONTALK)
QUIT
+2 WRITE !," RX#: ",$SELECT($DATA(PSOTMP(52,PSORXN,.01,"E")):PSOTMP(52,PSORXN,.01,"E"),1:"Not Available")
+3 WRITE ?19,"FILL DATE: ",$SELECT($DATA(PSOTMP(52,PSORXN,22,"E")):PSOTMP(52,PSORXN,22,"E"),1:"Not Available")
+4 WRITE ?48,"PHYSICIAN: ",$SELECT($DATA(PSOTMP(52,PSORXN,4,"E")):PSOTMP(52,PSORXN,4,"E"),1:"Not Available")
+5 WRITE !,"DRUG: ",$SELECT($DATA(PSOTMP(52,PSORXN,6,"E")):PSOTMP(52,PSORXN,6,"E"),1:"Not Available")
+6 WRITE ?47,"QTY: ",$SELECT($DATA(PSOTMP(52,PSORXN,7,"E")):$JUSTIFY(PSOTMP(52,PSORXN,7,"E"),4),1:"Not Available")
+7 WRITE ?66,"DAYS SUP: ",$SELECT($DATA(PSOTMP(52,PSORXN,8,"E")):PSOTMP(52,PSORXN,8,"E"),1:"Not Available")
+8 IF PSOFILL
WRITE !,?17,"REFILL DATE: ",$SELECT($DATA(PSOTMP(52.1,PSOFILL,.01,"E")):PSOTMP(52.1,PSOFILL,.01,"E"),1:"Not Available")
+9 KILL PSOTMP
QUIT
