- 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 Feb 18, 2025@23:58:06 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