- 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 ;