XPAR2.m

XPAR2 ;SLC/KCM - Supporting Calls - Update [ 04/02/2003   8:47 AM ]

 ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 ;;7.3;TOOLKIT;**26**;Apr 25, 1995

 ;

DOADD ; call Fileman to add a new entry

 I $D(^XTV(8989.5,"AC",PAR,ENT,INST)) S ERR=$$ERR^XPARDD(89895006) Q

 I $D(XPARCHK) D VALID^XPARDD(PAR,.VAL,"V",.ERR) Q:ERR

 N FDA,FDAIEN,DIERR

 S FDA(8989.5,"+1,",.01)=ENT

 S FDA(8989.5,"+1,",.02)=PAR

 S FDA(8989.5,"+1,",.03)=INST

 S FDA(8989.5,"+1,",1)=VAL

 D UPDATE^DIE("","FDA","FDAIEN","ERR")

 I $D(DIERR) S ERR=$$ERR^XPARDD(89895009) Q      ; filing error

 N WPIEN S WPIEN=FDAIEN(1) D CHKWP

 Q

DOCHG ; call Fileman to change VALUE field

 N IEN,FDA,DIERR

 S IEN=+$O(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 I 'IEN S ERR=$$ERR^XPARDD(89895008) Q           ; instance not found

 I $D(XPARCHK) D VALID^XPARDD(PAR,.VAL,"V",.ERR) Q:ERR

 S FDA(8989.5,IEN_",",1)=VAL

 D FILE^DIE("","FDA","ERR")

 I $D(DIERR) S ERR=$$ERR^XPARDD(89895009)        ; filing error

 N WPIEN S WPIEN=IEN D CHKWP

 Q

DOREP ; call Fileman to replace INSTANCE value with a new value

 N IEN,FDA,DIERR

 S IEN=+$O(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 I 'IEN S ERR=$$ERR^XPARDD(89895008) Q           ; instance not found

 I $D(XPARCHK) D VALID^XPARDD(PAR,.NEWINST,"I",.ERR) Q:ERR

 I $D(^XTV(8989.5,"AC",PAR,ENT,NEWINST)) S ERR=$$ERR^XPARDD(89895006) Q

 S FDA(8989.5,IEN_",",.03)=NEWINST

 D FILE^DIE("","FDA","ERR")

 I $D(DIERR) S ERR=$$ERR^XPARDD(89895009)        ; filing error

 Q

CHKWP ; check for word processing value and file

 Q:$D(VAL)'=11  Q:$P($G(^XTV(8989.51,PAR,1)),"^",1)'="W"

 D WP^DIE(8989.5,WPIEN_",",2,"","VAL","ERR")

 I $D(DIERR) S ERR=$$ERR^XPARDD(89895009)

 Q

DODEL ; call Fileman to delete this instance

 N DA,DIK

 S DA=$O(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 I 'DA S ERR="1^Parameter instance not found" Q

 S DIK="^XTV(8989.5," D ^DIK

 Q

XPAR2     ;SLC/KCM - Supporting Calls - Update [ 04/02/2003   8:47 AM ]

 +1       ;;7.3;TOOLKIT;**1001**;APR 1, 2003

 +2       ;;7.3;TOOLKIT;**26**;Apr 25, 1995

 +3       ;

DOADD     ; call Fileman to add a new entry

 +1        IF $DATA(^XTV(8989.5,"AC",PAR,ENT,INST))

               SET ERR=$$ERR^XPARDD(89895006)

               QUIT 

 +2        IF $DATA(XPARCHK)

               DO VALID^XPARDD(PAR,.VAL,"V",.ERR)

               IF ERR

                   QUIT 

 +3        NEW FDA,FDAIEN,DIERR

 +4        SET FDA(8989.5,"+1,",.01)=ENT

 +5        SET FDA(8989.5,"+1,",.02)=PAR

 +6        SET FDA(8989.5,"+1,",.03)=INST

 +7        SET FDA(8989.5,"+1,",1)=VAL

 +8        DO UPDATE^DIE("","FDA","FDAIEN","ERR")

 +9       ; filing error

           IF $DATA(DIERR)

               SET ERR=$$ERR^XPARDD(89895009)

               QUIT 

 +10       NEW WPIEN

           SET WPIEN=FDAIEN(1)

           DO CHKWP

 +11       QUIT 

DOCHG     ; call Fileman to change VALUE field

 +1        NEW IEN,FDA,DIERR

 +2        SET IEN=+$ORDER(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 +3       ; instance not found

           IF 'IEN

               SET ERR=$$ERR^XPARDD(89895008)

               QUIT 

 +4        IF $DATA(XPARCHK)

               DO VALID^XPARDD(PAR,.VAL,"V",.ERR)

               IF ERR

                   QUIT 

 +5        SET FDA(8989.5,IEN_",",1)=VAL

 +6        DO FILE^DIE("","FDA","ERR")

 +7       ; filing error

           IF $DATA(DIERR)

               SET ERR=$$ERR^XPARDD(89895009)

 +8        NEW WPIEN

           SET WPIEN=IEN

           DO CHKWP

 +9        QUIT 

DOREP     ; call Fileman to replace INSTANCE value with a new value

 +1        NEW IEN,FDA,DIERR

 +2        SET IEN=+$ORDER(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 +3       ; instance not found

           IF 'IEN

               SET ERR=$$ERR^XPARDD(89895008)

               QUIT 

 +4        IF $DATA(XPARCHK)

               DO VALID^XPARDD(PAR,.NEWINST,"I",.ERR)

               IF ERR

                   QUIT 

 +5        IF $DATA(^XTV(8989.5,"AC",PAR,ENT,NEWINST))

               SET ERR=$$ERR^XPARDD(89895006)

               QUIT 

 +6        SET FDA(8989.5,IEN_",",.03)=NEWINST

 +7        DO FILE^DIE("","FDA","ERR")

 +8       ; filing error

           IF $DATA(DIERR)

               SET ERR=$$ERR^XPARDD(89895009)

 +9        QUIT 

CHKWP     ; check for word processing value and file

 +1        IF $DATA(VAL)'=11

               QUIT 

           IF $PIECE($GET(^XTV(8989.51,PAR,1)),"^",1)'="W"

               QUIT 

 +2        DO WP^DIE(8989.5,WPIEN_",",2,"","VAL","ERR")

 +3        IF $DATA(DIERR)

               SET ERR=$$ERR^XPARDD(89895009)

 +4        QUIT 

DODEL     ; call Fileman to delete this instance

 +1        NEW DA,DIK

 +2        SET DA=$ORDER(^XTV(8989.5,"AC",PAR,ENT,INST,0))

 +3        IF 'DA

               SET ERR="1^Parameter instance not found"

               QUIT 

 +4        SET DIK="^XTV(8989.5,"

           DO ^DIK

 +5        QUIT