Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOOCKV1

PSOOCKV1.m

Go to the documentation of this file.
  1. PSOOCKV1 ; BIR/SAB - displays stored order checks ;01/22/13 02:22
  1. ;;7.0;OUTPATIENT PHARMACY;**411**;DEC 1997;Build 95
  1. ;External reference to ^PSS55 supported by DBIA 4826
  1. ;
  1. UD ;
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. N OLDIEN,UDDOSE,UDSTRT,UDSTOP,UDSEQ,UDDRG,UDSCHED S OLDIEN=IEN
  1. D PSS431^PSS55(DFN,+ZIEN,"","","PSS55U")
  1. D PSS433^PSS55(DFN,"PSS55U2")
  1. S IEN=OLDIEN
  1. 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
  1. .S (UDDRG,UDSCHED,UDDOSE,UDSTRT,UDSTOP)=""
  1. .S UDDRG=^TMP($J,"PSS55U",+ZIEN,"DDRUG",UDSEQ,.01)
  1. .S:$D(^TMP($J,"PSS55U",+ZIEN,26)) UDSCHED=^TMP($J,"PSS55U",+ZIEN,26)
  1. .S:$D(^TMP($J,"PSS55U",+ZIEN,109)) UDDOSE=^TMP($J,"PSS55U",+ZIEN,109)
  1. .S:$D(^TMP($J,"PSS55U",+ZIEN,10)) UDSTRT=^TMP($J,"PSS55U",+ZIEN,10)
  1. .S:$D(^TMP($J,"PSS55U2",+ZIEN,34)) UDSTOP=^TMP($J,"PSS55U2",+ZIEN,34)
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Clinic Order: "_$P(UDDRG,"^",2) ;$$GET1^DIQ(55.07,"1,"_ZIEN_","_DFN_",",.01)
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Schedule: "_UDSCHED
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Dosage: "_UDDOSE
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Start Date: "_$S($P(UDSTRT,"^",2)'="":$P(UDSTRT,"^",2),1:"********")
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" Stop Date: "_$S($P(UDSTOP,"^",2)'="":$P(UDSTOP,"^",2),1:"********")
  1. K ^TMP($J,"PSS55U"),^TMP($J,"PSS55U2")
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. Q
  1. ;
  1. IV ;
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. N OLDIEN,IVSTRT,IVSTOP,ADDNAM,ADDSTR,ADDSEQ,ADDBOT,SOLSEQ,IVSCHED,DA,DIE,DR,DIC,DIQ,ADDIA,INFUSE,INFUSE2,SOLSTR,SOLNAM
  1. K ^UTILITY("DIQ1",$J)
  1. S OLDIEN=IEN
  1. D PSS436^PSS55(DFN,+ZIEN,"PSS55ICL")
  1. Q:'$P($G(^TMP($J,"PSS55ICL",0)),"^")
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. S IEN=OLDIEN,IVSCHED=""
  1. S X="Clinic Order: ",ADDSEQ=0,(IVSTRT,IVSTOP,IVSCHED)=""
  1. S:$D(^TMP($J,"PSS55ICL",+ZIEN,.02)) IVSTRT=^TMP($J,"PSS55ICL",+ZIEN,.02),IVSTRT=$P(IVSTRT,"^",2)
  1. S:$D(^TMP($J,"PSS55ICL",+ZIEN,.03)) IVSTOP=^TMP($J,"PSS55ICL",+ZIEN,.03),IVSTOP=$P(IVSTOP,"^",2)
  1. S:$D(^TMP($J,"PSS55ICL",+ZIEN,.09)) IVSCHED=^TMP($J,"PSS55ICL",+ZIEN,.09)
  1. F S ADDSEQ=$O(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ)) Q:ADDSEQ="" D
  1. .S (ADDNAM,ADDSTR,ADDBOT,INFUSE)=""
  1. .S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01)) ADDNAM=$P(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.01),"^",2)
  1. .S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02)) ADDSTR=^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.02)
  1. .S:$D(^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03)) ADDBOT=^TMP($J,"PSS55ICL",+ZIEN,"ADD",ADDSEQ,.03)
  1. .Q:ADDNAM=""
  1. .S ADDIA=""
  1. .I $D(ADD(+ZIEN)) S ADDIA=ADD(+ZIEN)
  1. .S X=X_$S(ADDIA[ADDNAM:"*",1:" ")_ADDNAM_" "_ADDSTR S:ADDBOT'="" X=X_" ("_ADDBOT_")"
  1. .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X,X=" "
  1. S X=" in ",SOLSEQ=0
  1. F S SOLSEQ=$O(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ)) Q:SOLSEQ="" D
  1. .S (SOLNAM,SOLSTR,INFUSE,INFUSE2)=""
  1. .I $D(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01)) S SOLNAM=$P(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,.01),"^",2)
  1. .I $D(^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1)) S SOLSTR=^TMP($J,"PSS55ICL",+ZIEN,"SOL",SOLSEQ,1)
  1. .I $D(^TMP($J,"PSS55ICL",+ZIEN,.08)) S INFUSE=^TMP($J,"PSS55ICL",+ZIEN,.08),INFUSE=$P(INFUSE,"@")
  1. .Q:SOLNAM=""
  1. .S X=X_SOLNAM_" "_$P(SOLSTR,"^",2)_" @ "_INFUSE,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X,X=" "
  1. S X=" Schedule: "_IVSCHED
  1. S X=" Start Date: "_IVSTRT,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X
  1. S X=" Stop Date: "_IVSTOP,IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=X
  1. S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" "
  1. K ^TMP($J,"PSS55ICL"),X
  1. Q