BRA5POST.m

BRA5POST ;IHS/ITSC/CLS - IHS POST INIT FOR RAD/NUC MED 5.0

 ;;5.0;Radiology/Nuclear Medicine;;Feb 20, 2004

EN ;

 D KEY,VAR1,VAR2,RAD Q

KEY ;add 'RA OVERALL' key to the RA OVERALL option

 N IENS,SKIEN,FDA,ERR

 S IENS=$$FIND1^DIC(19,"","","RA OVERALL")

 Q:'IENS  ;quit if option doesn't exist

 S FDA(19,IENS_",",3)="RA OVERALL"

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

 ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 Q

VAR1 ;modify internal variable and mumps code

 N IENS,SKIEN,FDA,ERR

 S IENS=$$FIND1^DIC(78.7,"","","DATE OF BIRTH (AGE yrs)")

 Q:'IENS  ;quit if option doesn't exist

 S FDA(78.7,IENS_",",5)="RAZDOB"

 S FDA(78.7,IENS_",",100)="S RADOB=$P(RAY0,""^"",3),RADOB=$E(RADOB,4,5)_""-""_$E(RADOB,6,7)_""-""_(1700+$E(RADOB,1,3)),DFN=RADFN D DEM^VADPT S RAZDOB=RADOB_""   (""_VADM(4)_"")"""

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

 ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 Q

VAR2 ;modify internal variable and mumps code

 N IENS,SKIEN,FDA,ERR

 S IENS=$$FIND1^DIC(78.7,"","","CHART# OF PATIENT (IHS)")

 Q:'IENS  ;quit if option doesn't exist

 S FDA(78.7,IENS_",",5)="RAS"

 S FDA(78.7,IENS_",",100)="S RAS=$$SSN^RAUTL"

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

 ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 Q

RAD D LINK("RA EVSEND OR","RA IHS HOOK")  ;IHS/CIA/PLS 17-Jan-2002

 Q

 ;

LINK(P,C) ;

 ;Input: P-Parent protocol

 ;       C-Child protocol

 N IENARY,PIEN,AIEN,FDA,ERR

 Q:'$L(P)!('$L(C))

 S IENARY(1)=$$FIND1^DIC(101,"","",P)

 S AIEN=$$FIND1^DIC(101,"","",C)

 Q:'IENARY(1)!'AIEN

 S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN

 D UPDATE^DIE("S","FDA","IENARY","ERR")

 ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 Q

BRA5POST  ;IHS/ITSC/CLS - IHS POST INIT FOR RAD/NUC MED 5.0

 +1       ;;5.0;Radiology/Nuclear Medicine;;Feb 20, 2004

EN        ;

 +1        DO KEY

           DO VAR1

           DO VAR2

           DO RAD

           QUIT 

KEY       ;add 'RA OVERALL' key to the RA OVERALL option

 +1        NEW IENS,SKIEN,FDA,ERR

 +2        SET IENS=$$FIND1^DIC(19,"","","RA OVERALL")

 +3       ;quit if option doesn't exist

           IF 'IENS

               QUIT 

 +4        SET FDA(19,IENS_",",3)="RA OVERALL"

 +5        DO FILE^DIE("S","FDA","ERR")

 +6       ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 +7        QUIT 

VAR1      ;modify internal variable and mumps code

 +1        NEW IENS,SKIEN,FDA,ERR

 +2        SET IENS=$$FIND1^DIC(78.7,"","","DATE OF BIRTH (AGE yrs)")

 +3       ;quit if option doesn't exist

           IF 'IENS

               QUIT 

 +4        SET FDA(78.7,IENS_",",5)="RAZDOB"

 +5        SET FDA(78.7,IENS_",",100)="S RADOB=$P(RAY0,""^"",3),RADOB=$E(RADOB,4,5)_""-""_$E(RADOB,6,7)_""-""_(1700+$E(RADOB,1,3)),DFN=RADFN D DEM^VADPT S RAZDOB=RADOB_""   (""_VADM(4)_"")"""

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

 +7       ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 +8        QUIT 

VAR2      ;modify internal variable and mumps code

 +1        NEW IENS,SKIEN,FDA,ERR

 +2        SET IENS=$$FIND1^DIC(78.7,"","","CHART# OF PATIENT (IHS)")

 +3       ;quit if option doesn't exist

           IF 'IENS

               QUIT 

 +4        SET FDA(78.7,IENS_",",5)="RAS"

 +5        SET FDA(78.7,IENS_",",100)="S RAS=$$SSN^RAUTL"

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

 +7       ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 +8        QUIT 

RAD       ;IHS/CIA/PLS 17-Jan-2002

           DO LINK("RA EVSEND OR","RA IHS HOOK")

 +1        QUIT 

 +2       ;

LINK(P,C) ;

 +1       ;Input: P-Parent protocol

 +2       ;       C-Child protocol

 +3        NEW IENARY,PIEN,AIEN,FDA,ERR

 +4        IF '$LENGTH(P)!('$LENGTH(C))

               QUIT 

 +5        SET IENARY(1)=$$FIND1^DIC(101,"","",P)

 +6        SET AIEN=$$FIND1^DIC(101,"","",C)

 +7        IF 'IENARY(1)!'AIEN

               QUIT 

 +8        SET FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN

 +9        DO UPDATE^DIE("S","FDA","IENARY","ERR")

 +10      ;I $G(ERR("DIERR",1)) W ! ZW ERR  ;IHS/CIA/PLS for debugging use

 +11       QUIT