WV22PST.m

WV22PST ;HIOFO/FT-WV*1*22 POST INSTALLATION ROUTINE; 1/30/07 9:29am

 ;;1.0;WOMEN'S HEALTH;**22**;Sep 30, 1998;Build 1

 ;

ENV ;Main entry point for Environment check point.

 ;

 S XPDABORT=""

 D PROGCHK(.XPDABORT) ;checks programmer variables

 I XPDABORT="" K XPDABORT

 Q

 ;

POST ;Main entry point for Post-init items.

 ;

 ;Change the CPT codes for mammograms in file 790.2

 N X,Y,Z,OLDCPT,NEWCPT

 F X="MAMMOGRAM DX BILAT","MAMMOGRAM DX UNILAT","MAMMOGRAM SCREENING" D

 . S Y=$O(^WV(790.2,"B",X,0)) Q:Y'>0

 . S Z=$G(^WV(790.2,Y,0)) Q:Z=""

 . S OLDCPT=$P(Z,"^",8) I OLDCPT'=76090,OLDCPT'=76091,OLDCPT'=76092 Q

 . S NEWCPT=$S(X="MAMMOGRAM DX BILAT":77056,X="MAMMOGRAM DX UNILAT":77055,X="MAMMOGRAM SCREENING":77057,1:"") Q:NEWCPT=""

 . S $P(Z,"^",8)=NEWCPT,^WV(790.2,Y,0)=Z

 . ; update cross-reference

 . K ^WV(790.2,"AC",OLDCPT,Y)

 . S ^WV(790.2,"AC",NEWCPT,Y)=""

 Q

 ;

PROGCHK(XPDABORT) ;checks for necessary programmer variables

 ;

 I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D

 .D BMES^XPDUTL("*****")

 .D MES^XPDUTL("Your programming variables are not set up properly.")

 .D MES^XPDUTL("Installation aborted.")

 .D MES^XPDUTL("*****")

 .S XPDABORT=2

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---WV22PST   1197     printed  Apr 09, 2024@21:49:55                                                                                                                                                                                                     Page 2

WV22PST   ;HIOFO/FT-WV*1*22 POST INSTALLATION ROUTINE; 1/30/07 9:29am

 +1       ;;1.0;WOMEN'S HEALTH;**22**;Sep 30, 1998;Build 1

 +2       ;

ENV       ;Main entry point for Environment check point.

 +1       ;

 +2        SET XPDABORT=""

 +3       ;checks programmer variables

           DO PROGCHK(.XPDABORT)

 +4        IF XPDABORT=""

               KILL XPDABORT

 +5        QUIT 

 +6       ;

POST      ;Main entry point for Post-init items.

 +1       ;

 +2       ;Change the CPT codes for mammograms in file 790.2

 +3        NEW X,Y,Z,OLDCPT,NEWCPT

 +4        FOR X="MAMMOGRAM DX BILAT","MAMMOGRAM DX UNILAT","MAMMOGRAM SCREENING"

               Begin DoDot:1

 +5                SET Y=$ORDER(^WV(790.2,"B",X,0))

                   if Y'>0

                       QUIT 

 +6                SET Z=$GET(^WV(790.2,Y,0))

                   if Z=""

                       QUIT 

 +7                SET OLDCPT=$PIECE(Z,"^",8)

                   IF OLDCPT'=76090

                       IF OLDCPT'=76091

                           IF OLDCPT'=76092

                               QUIT 

 +8                SET NEWCPT=$SELECT(X="MAMMOGRAM DX BILAT":77056,X="MAMMOGRAM DX UNILAT":77055,X="MAMMOGRAM SCREENING":77057,1:"")

                   if NEWCPT=""

                       QUIT 

 +9                SET $PIECE(Z,"^",8)=NEWCPT

                   SET ^WV(790.2,Y,0)=Z

 +10      ; update cross-reference

 +11               KILL ^WV(790.2,"AC",OLDCPT,Y)

 +12               SET ^WV(790.2,"AC",NEWCPT,Y)=""

               End DoDot:1

 +13       QUIT 

 +14      ;

PROGCHK(XPDABORT) ;checks for necessary programmer variables

 +1       ;

 +2        IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")

               Begin DoDot:1

 +3                DO BMES^XPDUTL("*****")

 +4                DO MES^XPDUTL("Your programming variables are not set up properly.")

 +5                DO MES^XPDUTL("Installation aborted.")

 +6                DO MES^XPDUTL("*****")

 +7                SET XPDABORT=2

               End DoDot:1

 +8        QUIT