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