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

APSPCO1.m

Go to the documentation of this file.
  1. APSPCO1 ; IHS/MSC/PLS - List Manager Complete Orders, CON'T ;24-Jul-2013 08:46;PLS
  1. ;;7.0;IHS PHARMACY MODIFICATIONS;**1013**;Sep 23, 2004;Build 74
  1. ;=================================================================
  1. Q
  1. ; Input: EFLG - Edit flag
  1. PMTLLST(EFLG) ;EP- Prompt user for location restriction list
  1. N DIC,Y
  1. S DIC=9009033.6,DIC(0)="AEMQZ"_$S($G(EFLG):"L",1:"")
  1. I $G(EFLG) D
  1. .S DIC("A")="Select/Create location restriction list: "
  1. E S DIC("A")="Select location restriction list('^' to ignore): "
  1. D ^DIC
  1. Q $S(Y>0:+Y,1:0)
  1. ;
  1. EDTLLST ;EP- Create/Edit a location restriction list
  1. N DA,DIE,DR,DIDEL,DUOUT,DLAYGO
  1. S DLAYGO=9009033.6
  1. S DA=$$PMTLLST(1)
  1. Q:DA<1
  1. S DR=".01;1",DIE=9009033.6 D ^DIE
  1. Q
  1. CHGCOM ;EP- Change comment associated with order
  1. N DA,DUOUT,Y,VAL,ITM,DTOUT,DIRUT,DIE,DR,LST,APSPCOQF,COM
  1. S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_VALMCNT D ^DIR
  1. I $D(DUOUT) S VALMBCK="R" Q
  1. I +Y D FULL^VALM1 S LST=Y
  1. F ITM=1:1:$L(LST,",") Q:$P(LST,",",ITM)']""!($G(APSPCOQF)) S VAL=$P(LST,",",ITM) D
  1. .S DA=$P(@VALMAR@(VAL,"POFIEN"),U,2)
  1. .I '$$GET1^DIQ(52.41,DA,.01) D Q
  1. ..W !,"This order has already been processed and removed from the Pending Order File!"
  1. .W !,"Comment for order number: "_$$GET1^DIQ(52.41,DA,.01)," on patient: "_$$GET1^DIQ(52.41,DA,1)
  1. .S DIE=52.41,DR="23" D ^DIE
  1. .S COM=$$GET1^DIQ(52.41,DA,23)
  1. .S COM=$S($L(COM)>30:$E(COM,1,27)_"...",1:COM)
  1. .D FLDTEXT^VALM10(VAL,"COMMENT",COM)
  1. .S APSPCO("QFLG")='+$$DIRYN^APSPUTIL("Continue: ","N",,.APSPPOP)
  1. S VALMBCK="R"
  1. Q