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

PXRMOCG.m

Go to the documentation of this file.
  1. PXRMOCG ;SLC/PKR - Routines for editing order check groups ;02/17/2012
  1. ;;2.0;CLINICAL REMINDERS;**22**;Feb 04, 2005;Build 160
  1. ;Also contains routines used by the DD for file #801.
  1. ;=============================================
  1. GETPINM(VP) ;Given the variable pointer VP get the pharmacy item name.
  1. N FNUM,IEN,NAME,PREFIX,ROOT,VPL
  1. S IEN=$P(VP,";",1)
  1. S ROOT=U_$P(VP,";",2)
  1. S FNUM=$$FNFR^PXRMUTIL(ROOT)
  1. S NAME=$$GET1^DIQ(FNUM,IEN,.01)
  1. D BLDNLIST^PXRMVPTR(801.015,.01,.VPL)
  1. S PREFIX=$P(VPL(FNUM),U,4)_"."
  1. Q PREFIX_NAME
  1. ;
  1. ;=============================================
  1. KPID(DA,X) ;Kill logic for Pharmacy Item PID cross-reference.
  1. N NAME
  1. S NAME=$$PIOT^PXRMOCG(.DA,X)
  1. K ^PXD(801,DA(1),1.5,"PIDO",NAME,DA)
  1. K ^PXD(801,DA(1),1.5,"PIDN",DA)
  1. Q
  1. ;
  1. ;=============================================
  1. OICAP(IEN) ;Executable caption for the orderable item selection.
  1. N NUM
  1. S NUM=+$P($G(^PXD(801,IEN,2,0)),U,4)
  1. Q "ORDERABLE ITEM LIST ("_NUM_" "_$S(NUM=1:"entry",1:"entries")_")"
  1. ;
  1. ;=============================================
  1. OCRCAP(IEN) ;Executable caption for the reminder order checks rules list
  1. ;selection.
  1. N NUM
  1. S NUM=+$P($G(^PXD(801,IEN,3,0)),U,4)
  1. Q "REMINDER ORDER CHECKS RULES LIST ("_NUM_" "_$S(NUM=1:"entry",1:"entries")_")"
  1. ;
  1. ;=============================================
  1. PICAP(IEN) ;Executable caption for the pharmacy item selection.
  1. N NUM
  1. S NUM=+$P($G(^PXD(801,IEN,1.5,0)),U,4)
  1. Q "PHARMACY ITEM LIST ("_NUM_" "_$S(NUM=1:"entry",1:"entries")_")"
  1. ;
  1. ;=============================================
  1. PIOT(DA,PI) ;Output transform for pharmacy items.
  1. I '$D(DDS) Q $$GETPINM^PXRMOCG(PI)
  1. I DA=0 Q $$GETPINM^PXRMOCG(PI)
  1. Q ^PXD(801,DA(1),1.5,"PIDN",DA)
  1. ;
  1. ;=============================================
  1. SPID(DA,X) ;Set logic for Pharmacy Item PID cross-reference.
  1. N FNUM,IEN,NAME,PREFIX,ROOT,VPL
  1. S NAME=$$GETPINM^PXRMOCG(X)
  1. S ^PXD(801,DA(1),1.5,"PIDO",NAME,DA)=""
  1. S ^PXD(801,DA(1),1.5,"PIDN",DA)=NAME
  1. Q
  1. ;
  1. ;=============================================
  1. SMANEDIT(IEN,NEW) ;Invoke the ScreeMan editor for entry IEN.
  1. N DA,DR,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,OIGCLASS,RESTRICT
  1. S DDSFILE=801,DDSPARM="CS"
  1. S OIGCLASS=$P($G(^PXD(801,IEN,100)),U,1)
  1. S RESTRICT=$S($G(PXRMINST):0,OIGCLASS="N":1,1:0)
  1. S DR=$S(RESTRICT:"[PXRM OCG EDIT RESTRICTED]",1:"[PXRM OCG EDIT]")
  1. S DA=IEN
  1. D ^DDS
  1. ;If the entry is new and the user did not save, delete it.
  1. I $G(NEW),$G(DDSSAVE)'=1 D DELETE^PXRMEXFI(801,IEN) Q
  1. ;If changes were made update the edit history.
  1. I $G(DDSCHANG)'=1 Q
  1. ;Make sure the change was not a deletion.
  1. I '$D(^PXD(801,IEN)) Q
  1. N IENS,FDA,FDAIEN,MSG
  1. S IENS="+1,"_IEN_","
  1. S FDA(801.03,IENS,.01)=$$NOW^XLFDT
  1. S FDA(801.03,IENS,1)=DUZ
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. K DA,DDSFILE
  1. S DA=FDAIEN(1),DA(1)=IEN
  1. S DDSFILE=801,DDSFILE(1)=801.03
  1. S DR="[PXRM OCG EDIT HISTORY]"
  1. D ^DDS
  1. Q
  1. ;
  1. ;=============================================
  1. VRULE(RULEIEN,DA) ;If the rules in a national orderable item group are being
  1. ;edited by a site national rules cannot be added or deleted. The
  1. ;ScreenMan form PXRM OCG EDIT RESTRICTED is for restricted editing.
  1. ;This check is made from the LAYGO and DEL nodes of the Rule List
  1. ;multiple. Return 1 if the entry can be added 0 if it cannot.
  1. I $G(PXRMINST) Q 1
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. N FORMNAME,OIGCLASS,RESTRICT,RULECLASS
  1. S OIGCLASS=$P($G(^PXD(801,DA(1),100)),U,1)
  1. I OIGCLASS'="N" Q 1
  1. I '$D(DDS) S RESTRICT=1
  1. I $D(DDS) D
  1. . ;DBIA #5746
  1. . S FORMNAME=$P(DDS,U,2)
  1. . S RESTRICT=$S(FORMNAME="PXRM OCG EDIT RESTRICTED":1,1:0)
  1. I 'RESTRICT Q 1
  1. S RULECLASS=$P($G(^PXD(801.1,RULEIEN,100)),U,1)
  1. I RESTRICT,(RULECLASS="N") Q 0
  1. Q 1
  1. ;
  1. ;=============================================
  1. VRULEA(RULEIEN,DA) ;This check is made from the LAYGO node of the Rule
  1. ;List multiple. Return 1 if the entry can be added 0 if it cannot.
  1. N ADD
  1. S ADD=$$VRULE^PXRMOCG(RULEIEN,.DA)
  1. I 'ADD D EN^DDIOL("Sites cannot add national Reminder Order Check Rules from national Reminder Order Check Items Groups.")
  1. Q ADD
  1. ;
  1. ;=============================================
  1. VRULED(DA) ;This check is made from the DEL node of the Rule List
  1. ;multiple. Return 1 if the field canot be deleted, 0 if it can.
  1. N NODEL,RULEIEN
  1. S RULEIEN=$P(^PXD(801,DA(1),3,DA,0),U,1)
  1. S NODEL='$$VRULE^PXRMOCG(RULEIEN,.DA)
  1. I NODEL D EN^DDIOL("Sites cannot delete national Reminder Order Check Rules from national Reminder Order Check Items Groups.")
  1. Q NODEL
  1. ;
  1. ;=============================================
  1. VRULESCR(RULEIEN,DA) ;Screen for the .01 of the Rule List multiple.
  1. N VALID
  1. S VALID=$$VRULE^PXRMOCG(RULEIEN,.DA)
  1. Q VALID
  1. ;