PSOOCKV1 ; BIR/SAB - displays stored order checks ;01/22/13 02:22
;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
;External reference to ^PSS55 supported by DBIA 4826
;
UD ;
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
N OLDIEN,UDDOSE,UDSTRT,UDSTOP,UDSEQ,UDDRG,UDSCHED S OLDIEN=IEN
D PSS431^PSS55(DFN,+ZIEN,"","","PSS55U")
D PSS433^PSS55(DFN,"PSS55U2")
S IEN=OLDIEN
S UDSEQ=0 F S UDSEQ=$O(^TMP($J,"PSS55U",+ZIEN,"DDRUG",UDSEQ)) Q:UDSEQ="" I $D(^TMP($J,"PSS55U",+ZIEN,"DDRUG",UDSEQ,.01)) D
.S (UDDRG,UDSCHED,UDDOSE,UDSTRT,UDSTOP)=""
.S UDDRG=^TMP($J,"PSS55U",+ZIEN,"DDRUG",UDSEQ,.01)
.S:$D(^TMP($J,"PSS55U",+ZIEN,26)) UDSCHED=^TMP($J,"PSS55U",+ZIEN,26)
.S:$D(^TMP($J,"PSS55U",+ZIEN,109)) UDDOSE=^TMP($J,"PSS55U",+ZIEN,109)
.S:$D(^TMP($J,"PSS55U",+ZIEN,10)) UDSTRT=^TMP($J,"PSS55U",+ZIEN,10)
.S:$D(^TMP($J,"PSS55U2",+ZIEN,34)) UDSTOP=^TMP($J,"PSS55U2",+ZIEN,34)
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Clinic Order: "_$P(UDDRG,"^",2) ;$$GET1^DIQ(55.07,"1,"_ZIEN_","_DFN_",",.01)
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Schedule: "_UDSCHED
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Dosage: "_UDDOSE
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Start Date: "_$S($P(UDSTRT,"^",2)'="":$P(UDSTRT,"^",2),1:"********")
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Stop Date: "_$S($P(UDSTOP,"^",2)'="":$P(UDSTOP,"^",2),1:"********")
K ^TMP($J,"PSS55U"),^TMP($J,"PSS55U2")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
Q
;
IV ;
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
N OLDIEN,IVSTRT,IVSTOP,ADDNAM,ADDSTR,ADDSEQ,ADDBOT,SOLSEQ,IVSCHED,DA,DIE,DR,DIC,DIQ,ADDIA,INFUSE,INFUSE2,SOLSTR,SOLNAM
K ^UTILITY("DIQ1",$J)
S OLDIEN=IEN
D PSS436^PSS55(DFN,+ZIEN,"PSS55ICL")
Q:'$P($G(^TMP($J,"PSS55ICL",0)),"^")
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
S IEN=OLDIEN,IVSCHED=""
S X="Clinic Order: ",ADDSEQ=0,(IVSTRT,IVSTOP,IVSCHED)=""
S:$D(^TMP($J,"PSS55ICL",+ZIEN,.02)) IVSTRT=^TMP($J,"PSS55ICL",+ZIEN,.02),IVSTRT=$P(IVSTRT,"^",2)
S:$D(^TMP($J,"PSS55ICL",+ZIEN,.03)) IVSTOP=^TMP($J,"PSS55ICL",+ZIEN,.03),IVSTOP=$P(IVSTOP,"^",2)
S:$D(^TMP($J,"PSS55ICL",+ZIEN,.09)) IVSCHED=^TMP($J,"PSS55ICL",+ZIEN,.09)
F S ADDSEQ=$O(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ)) Q:ADDSEQ="" D
.S (ADDNAM,ADDSTR,ADDBOT,INFUSE)=""
.S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01)) ADDNAM=$P(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01),"^",2)
.S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02)) ADDSTR=^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02)
.S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03)) ADDBOT=^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03)
.Q:ADDNAM=""
.S ADDIA=""
.I $D(ADD(+ZIEN)) S ADDIA=ADD(+ZIEN)
.S X=X_$S(ADDIA[ADDNAM:"*",1:" ")_ADDNAM_" "_ADDSTR S:ADDBOT'="" X=X_" ("_ADDBOT_")"
.S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X,X=" "
S X=" in ",SOLSEQ=0
F S SOLSEQ=$O(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ)) Q:SOLSEQ="" D
.S (SOLNAM,SOLSTR,INFUSE,INFUSE2)=""
.I $D(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01)) S SOLNAM=$P(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01),"^",2)
.I $D(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1)) S SOLSTR=^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1)
.I $D(^TMP($J,"PSS55ICL",+ZIEN,.08)) S INFUSE=^TMP($J,"PSS55ICL",+ZIEN,.08),INFUSE=$P(INFUSE,"@")
.Q:SOLNAM=""
.S X=X_SOLNAM_" "_$P(SOLSTR,"^",2)_" @ "_INFUSE,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X,X=" "
S X=" Schedule: "_IVSCHED
S X=" Start Date: "_IVSTRT,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X
S X=" Stop Date: "_IVSTOP,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X
S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
K ^TMP($J,"PSS55ICL"),X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOOCKV1 3586 printed Dec 13, 2024@02:31:41 Page 2
PSOOCKV1 ; BIR/SAB - displays stored order checks ;01/22/13 02:22
+1 ;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
+2 ;External reference to ^PSS55 supported by DBIA 4826
+3 ;
UD ;
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+2 NEW OLDIEN,UDDOSE,UDSTRT,UDSTOP,UDSEQ,UDDRG,UDSCHED
SET OLDIEN=IEN
+3 DO PSS431^PSS55(DFN,+ZIEN,"","","PSS55U")
+4 DO PSS433^PSS55(DFN,"PSS55U2")
+5 SET IEN=OLDIEN
+6 SET UDSEQ=0
FOR
SET UDSEQ=$ORDER(^TMP($JOB,"PSS55U",+ZIEN,"DDRUG",UDSEQ))
if UDSEQ=""
QUIT
IF $DATA(^TMP($JOB,"PSS55U",+ZIEN,"DDRUG",UDSEQ,.01))
Begin DoDot:1
+7 SET (UDDRG,UDSCHED,UDDOSE,UDSTRT,UDSTOP)=""
+8 SET UDDRG=^TMP($JOB,"PSS55U",+ZIEN,"DDRUG",UDSEQ,.01)
+9 if $DATA(^TMP($JOB,"PSS55U",+ZIEN,26))
SET UDSCHED=^TMP($JOB,"PSS55U",+ZIEN,26)
+10 if $DATA(^TMP($JOB,"PSS55U",+ZIEN,109))
SET UDDOSE=^TMP($JOB,"PSS55U",+ZIEN,109)
+11 if $DATA(^TMP($JOB,"PSS55U",+ZIEN,10))
SET UDSTRT=^TMP($JOB,"PSS55U",+ZIEN,10)
+12 if $DATA(^TMP($JOB,"PSS55U2",+ZIEN,34))
SET UDSTOP=^TMP($JOB,"PSS55U2",+ZIEN,34)
+13 ;$$GET1^DIQ(55.07,"1,"_ZIEN_","_DFN_",",.01)
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)="Clinic Order: "_$PIECE(UDDRG,"^",2)
+14 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Schedule: "_UDSCHED
+15 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Dosage: "_UDDOSE
+16 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Start Date: "_$SELECT($PIECE(UDSTRT,"^",2)'="":$PIECE(UDSTRT,"^",2),1:"********")
+17 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" Stop Date: "_$SELECT($PIECE(UDSTOP,"^",2)'="":$PIECE(UDSTOP,"^",2),1:"********")
End DoDot:1
+18 KILL ^TMP($JOB,"PSS55U"),^TMP($JOB,"PSS55U2")
+19 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+20 QUIT
+21 ;
IV ;
+1 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+2 NEW OLDIEN,IVSTRT,IVSTOP,ADDNAM,ADDSTR,ADDSEQ,ADDBOT,SOLSEQ,IVSCHED,DA,DIE,DR,DIC,DIQ,ADDIA,INFUSE,INFUSE2,SOLSTR,SOLNAM
+3 KILL ^UTILITY("DIQ1",$JOB)
+4 SET OLDIEN=IEN
+5 DO PSS436^PSS55(DFN,+ZIEN,"PSS55ICL")
+6 if '$PIECE($GET(^TMP($JOB,"PSS55ICL",0)),"^")
QUIT
+7 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+8 SET IEN=OLDIEN
SET IVSCHED=""
+9 SET X="Clinic Order: "
SET ADDSEQ=0
SET (IVSTRT,IVSTOP,IVSCHED)=""
+10 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,.02))
SET IVSTRT=^TMP($JOB,"PSS55ICL",+ZIEN,.02)
SET IVSTRT=$PIECE(IVSTRT,"^",2)
+11 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,.03))
SET IVSTOP=^TMP($JOB,"PSS55ICL",+ZIEN,.03)
SET IVSTOP=$PIECE(IVSTOP,"^",2)
+12 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,.09))
SET IVSCHED=^TMP($JOB,"PSS55ICL",+ZIEN,.09)
+13 FOR
SET ADDSEQ=$ORDER(^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ))
if ADDSEQ=""
QUIT
Begin DoDot:1
+14 SET (ADDNAM,ADDSTR,ADDBOT,INFUSE)=""
+15 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01))
SET ADDNAM=$PIECE(^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01),"^",2)
+16 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02))
SET ADDSTR=^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02)
+17 if $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03))
SET ADDBOT=^TMP($JOB,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03)
+18 if ADDNAM=""
QUIT
+19 SET ADDIA=""
+20 IF $DATA(ADD(+ZIEN))
SET ADDIA=ADD(+ZIEN)
+21 SET X=X_$SELECT(ADDIA[ADDNAM:"*",1:" ")_ADDNAM_" "_ADDSTR
if ADDBOT'=""
SET X=X_" ("_ADDBOT_")"
+22 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=X
SET X=" "
End DoDot:1
+23 SET X=" in "
SET SOLSEQ=0
+24 FOR
SET SOLSEQ=$ORDER(^TMP($JOB,"PSS55ICL",+ZIEN,"SOL",SOLSEQ))
if SOLSEQ=""
QUIT
Begin DoDot:1
+25 SET (SOLNAM,SOLSTR,INFUSE,INFUSE2)=""
+26 IF $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01))
SET SOLNAM=$PIECE(^TMP($JOB,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01),"^",2)
+27 IF $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1))
SET SOLSTR=^TMP($JOB,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1)
+28 IF $DATA(^TMP($JOB,"PSS55ICL",+ZIEN,.08))
SET INFUSE=^TMP($JOB,"PSS55ICL",+ZIEN,.08)
SET INFUSE=$PIECE(INFUSE,"@")
+29 if SOLNAM=""
QUIT
+30 SET X=X_SOLNAM_" "_$PIECE(SOLSTR,"^",2)_" @ "_INFUSE
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=X
SET X=" "
End DoDot:1
+31 SET X=" Schedule: "_IVSCHED
+32 SET X=" Start Date: "_IVSTRT
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=X
+33 SET X=" Stop Date: "_IVSTOP
SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=X
+34 SET IEN=IEN+1
SET ^TMP("PSOAL",$JOB,IEN,0)=" "
+35 KILL ^TMP($JOB,"PSS55ICL"),X
+36 QUIT
