PSO327PI ;VGH-CARRIAGE RETURNS IN HL7 RECORDS - RESEND ;3/11/09
;;7.0;OUTPATIENT PHARMACY;**327**;MAR 2009;Build 4
;THIS ROUTINE WILL ALLOW USERS TO ENTER THE PRESCRIPTION NUMBER THAT NEEDS TO BE RESENT TO THE HDR.
EN ;
D INIT
S PSODONE=0
F D PROMPT Q:PSODONE
Q
PROMPT ;DIC READ
W !!
K DIC,X,Y
S DIC=52,DIC(0)="AEQXZ"
D ^DIC
I Y<1 S PSODONE=1 Q
S PSORXIEN=$P(Y,"^"),PSORX=$P(Y,"^",2)
S PSOPAT=$P(Y(0),"^",2)
S PSODPT=$G(^DPT(PSOPAT,0))
S PSOPAT=$P(PSODPT,"^")
S PSOSSN=$E($P(PSODPT,"^",9),6,9)
W !,"Rx IEN: "_PSORXIEN
W !,"Patient: "_PSOPAT_" ("_PSOSSN_")",!
K DIR S DIR("A")="Is this Correct? "
S DIR(0)="SA^1:YES;0:NO"
S DIR("?")="Enter Y to resend the Prescription to the HDR"
D ^DIR
I Y<1 Q
D RESEND
W " ... SENT"
Q
RESEND ;RESEND PRESCRIPTION BACK TO HDR
D EN^PSOHDR("PRES",PSORXIEN)
Q
INIT ;INITIALIZE VARIABLES
K PSORX,PSORXIEN,PSOPAT,PSODONE,PSOSSN,PSODPT
K DIR,DIC,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO327PI 951 printed Dec 13, 2024@02:22:51 Page 2
PSO327PI ;VGH-CARRIAGE RETURNS IN HL7 RECORDS - RESEND ;3/11/09
+1 ;;7.0;OUTPATIENT PHARMACY;**327**;MAR 2009;Build 4
+2 ;THIS ROUTINE WILL ALLOW USERS TO ENTER THE PRESCRIPTION NUMBER THAT NEEDS TO BE RESENT TO THE HDR.
EN ;
+1 DO INIT
+2 SET PSODONE=0
+3 FOR
DO PROMPT
if PSODONE
QUIT
+4 QUIT
PROMPT ;DIC READ
+1 WRITE !!
+2 KILL DIC,X,Y
+3 SET DIC=52
SET DIC(0)="AEQXZ"
+4 DO ^DIC
+5 IF Y<1
SET PSODONE=1
QUIT
+6 SET PSORXIEN=$PIECE(Y,"^")
SET PSORX=$PIECE(Y,"^",2)
+7 SET PSOPAT=$PIECE(Y(0),"^",2)
+8 SET PSODPT=$GET(^DPT(PSOPAT,0))
+9 SET PSOPAT=$PIECE(PSODPT,"^")
+10 SET PSOSSN=$EXTRACT($PIECE(PSODPT,"^",9),6,9)
+11 WRITE !,"Rx IEN: "_PSORXIEN
+12 WRITE !,"Patient: "_PSOPAT_" ("_PSOSSN_")",!
+13 KILL DIR
SET DIR("A")="Is this Correct? "
+14 SET DIR(0)="SA^1:YES;0:NO"
+15 SET DIR("?")="Enter Y to resend the Prescription to the HDR"
+16 DO ^DIR
+17 IF Y<1
QUIT
+18 DO RESEND
+19 WRITE " ... SENT"
+20 QUIT
RESEND ;RESEND PRESCRIPTION BACK TO HDR
+1 DO EN^PSOHDR("PRES",PSORXIEN)
+2 QUIT
INIT ;INITIALIZE VARIABLES
+1 KILL PSORX,PSORXIEN,PSOPAT,PSODONE,PSOSSN,PSODPT
+2 KILL DIR,DIC,X,Y
+3 QUIT
