DVBAPTEX.m

DVBAPTEX ;ALB/CMM  EXAM FILE UPDATE - POST INT ; 12 MARCH 1997

 ;;2.7;AMIE;**12**;Apr 10, 1995

 ;

 ; This is the post-in for patch 12 to add a new body system to the

 ; 2507 Body System file (396.7) and to inactivate Exams and add the

 ; new Exams into the AMIE EXAM file (396.6).

 ;

DRIVE ;

 D MES^XPDUTL("Post Init Installation:")

 D MES^XPDUTL("Updating 2507 Body System file.")

 D ^DVBAPTBD

 ; ^ update 2507 Body System file (396.7)

 D MES^XPDUTL("Updating AMIE EXAM file.")

 I '$D(^DVB(396.6)) D MES^XPDUTL("Missing file 396.6, AMIE EXAM file")

 I $D(^DVB(396.6)) D

 .D INACT

 .D LOAD

 .D LOOP

 D MES^XPDUTL("Removing Files: ")

 D MES^XPDUTL("EXAM EXCEPTION (#396.93)")

 D MES^XPDUTL("AMIE DOCUMENT (#396.91)")

 D MES^XPDUTL("AMIE DOCUMENT TABLE OF CONTENTS (#396.92)")

 D REMOVE

 Q

 ;

REMOVE ;deletes files 396.93, 396.92 and 396.92 for Physician's Guide

 ;removes data and dd

 N NAME

 F NAME="^DVBP(396.91,","^DVBP(396.92,","^DVB(396.93," D

 .S DIU=NAME,DIU(0)="D"

 .D EN^DIU2

 K DIU

 Q

 ;

LOAD ;

 S DIF="^TMP($J,""DVBAPT"",",XCNP=0

 K ^TMP($J,"DVBAPT")

 F ROU="DVBAPT1" S X=ROU X ^%ZOSF("LOAD")

 ;DVBAPT1 contains all New exams to be active after this patch

 K DIF,XCNP,ROU

 Q

 ;

LOOP ;

 K LP,EXM,WKS,ROU,PNM,BDY,STAT,LINE,NAME

 S LP=0,NUM=99

 F  S LP=$O(^TMP($J,"DVBAPT",LP)) Q:LP=""  D

 .S LINE=^TMP($J,"DVBAPT",LP,0)

 .I (LINE'[";;")!(LINE[";AMIE;")!(LINE="") Q

 .S NUM=NUM+1

 .S EXM=$P(LINE,";",3) ;current exam name

 .S NAME=$P(LINE,";",4) ;new exam name

 .S WKS=$P(LINE,";",5) ;worksheet number

 .S PNM=$P(LINE,";",6) ;print name

 .S BDY=$P(LINE,";",7) ;body system

 .S STAT=$P(LINE,";",8) ;status

 .S ROU=$P(LINE,";",9) ;routine name

 .;

 .I NAME="" S NAME=EXM ;same name

 .;

 .I STAT="A" D NEW(NUM)

 K LP,EXM,WKS,ROU,PNM,BDY,STAT,LINE,NAME,NUM

 Q

 ;

INACT ; inactivate exam

 N LOOP

 S LOOP=0

 F  S LOOP=$O(^DVB(396.6,LOOP)) Q:'LOOP  D

 .S DIE="^DVB(396.6,",DA=+LOOP,DR=".5///I"

 .D ^DIE

 .K DIE,DA,DR

 Q

 ;

NEW(EN) ; add new exam

 K DD,DO,DIC,DA

 S DIC="^DVB(396.6,",DIC(0)="LZ",X=NAME,DINUM=EN

 S DIC("DR")=".07///"_WKS_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU

 D FILE^DICN

 I +Y=-1,$D(^DVB(396.6,EN)) D

 .;have entry already, make sure fields are all populated correctly

 .S DA=EN,DIE="^DVB(396.6,"

 .S DR=".07///"_WKS_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU_";.01///"_NAME

 .D ^DIE

 .K DIE,DA,DR

 I '$D(^DVB(396.6,EN)) D MES^XPDUTL("Unable to add exam, "_NAME_", IEN= ",EN)

 K DIC,X,Y,DINUM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBAPTEX   2518     printed  Feb 18, 2025@23:08:17                                                                                                                                                                                                    Page 2

DVBAPTEX  ;ALB/CMM  EXAM FILE UPDATE - POST INT ; 12 MARCH 1997

 +1       ;;2.7;AMIE;**12**;Apr 10, 1995

 +2       ;

 +3       ; This is the post-in for patch 12 to add a new body system to the

 +4       ; 2507 Body System file (396.7) and to inactivate Exams and add the

 +5       ; new Exams into the AMIE EXAM file (396.6).

 +6       ;

DRIVE     ;

 +1        DO MES^XPDUTL("Post Init Installation:")

 +2        DO MES^XPDUTL("Updating 2507 Body System file.")

 +3        DO ^DVBAPTBD

 +4       ; ^ update 2507 Body System file (396.7)

 +5        DO MES^XPDUTL("Updating AMIE EXAM file.")

 +6        IF '$DATA(^DVB(396.6))

               DO MES^XPDUTL("Missing file 396.6, AMIE EXAM file")

 +7        IF $DATA(^DVB(396.6))

               Begin DoDot:1

 +8                DO INACT

 +9                DO LOAD

 +10               DO LOOP

               End DoDot:1

 +11       DO MES^XPDUTL("Removing Files: ")

 +12       DO MES^XPDUTL("EXAM EXCEPTION (#396.93)")

 +13       DO MES^XPDUTL("AMIE DOCUMENT (#396.91)")

 +14       DO MES^XPDUTL("AMIE DOCUMENT TABLE OF CONTENTS (#396.92)")

 +15       DO REMOVE

 +16       QUIT 

 +17      ;

REMOVE    ;deletes files 396.93, 396.92 and 396.92 for Physician's Guide

 +1       ;removes data and dd

 +2        NEW NAME

 +3        FOR NAME="^DVBP(396.91,","^DVBP(396.92,","^DVB(396.93,"

               Begin DoDot:1

 +4                SET DIU=NAME

                   SET DIU(0)="D"

 +5                DO EN^DIU2

               End DoDot:1

 +6        KILL DIU

 +7        QUIT 

 +8       ;

LOAD      ;

 +1        SET DIF="^TMP($J,""DVBAPT"","

           SET XCNP=0

 +2        KILL ^TMP($JOB,"DVBAPT")

 +3        FOR ROU="DVBAPT1"

               SET X=ROU

               XECUTE ^%ZOSF("LOAD")

 +4       ;DVBAPT1 contains all New exams to be active after this patch

 +5        KILL DIF,XCNP,ROU

 +6        QUIT 

 +7       ;

LOOP      ;

 +1        KILL LP,EXM,WKS,ROU,PNM,BDY,STAT,LINE,NAME

 +2        SET LP=0

           SET NUM=99

 +3        FOR 

               SET LP=$ORDER(^TMP($JOB,"DVBAPT",LP))

               if LP=""

                   QUIT 

               Begin DoDot:1

 +4                SET LINE=^TMP($JOB,"DVBAPT",LP,0)

 +5                IF (LINE'[";;")!(LINE[";AMIE;")!(LINE="")

                       QUIT 

 +6                SET NUM=NUM+1

 +7       ;current exam name

                   SET EXM=$PIECE(LINE,";",3)

 +8       ;new exam name

                   SET NAME=$PIECE(LINE,";",4)

 +9       ;worksheet number

                   SET WKS=$PIECE(LINE,";",5)

 +10      ;print name

                   SET PNM=$PIECE(LINE,";",6)

 +11      ;body system

                   SET BDY=$PIECE(LINE,";",7)

 +12      ;status

                   SET STAT=$PIECE(LINE,";",8)

 +13      ;routine name

                   SET ROU=$PIECE(LINE,";",9)

 +14      ;

 +15      ;same name

                   IF NAME=""

                       SET NAME=EXM

 +16      ;

 +17               IF STAT="A"

                       DO NEW(NUM)

               End DoDot:1

 +18       KILL LP,EXM,WKS,ROU,PNM,BDY,STAT,LINE,NAME,NUM

 +19       QUIT 

 +20      ;

INACT     ; inactivate exam

 +1        NEW LOOP

 +2        SET LOOP=0

 +3        FOR 

               SET LOOP=$ORDER(^DVB(396.6,LOOP))

               if 'LOOP

                   QUIT 

               Begin DoDot:1

 +4                SET DIE="^DVB(396.6,"

                   SET DA=+LOOP

                   SET DR=".5///I"

 +5                DO ^DIE

 +6                KILL DIE,DA,DR

               End DoDot:1

 +7        QUIT 

 +8       ;

NEW(EN)   ; add new exam

 +1        KILL DD,DO,DIC,DA

 +2        SET DIC="^DVB(396.6,"

           SET DIC(0)="LZ"

           SET X=NAME

           SET DINUM=EN

 +3        SET DIC("DR")=".07///"_WKS_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU

 +4        DO FILE^DICN

 +5        IF +Y=-1

               IF $DATA(^DVB(396.6,EN))

                   Begin DoDot:1

 +6       ;have entry already, make sure fields are all populated correctly

 +7                    SET DA=EN

                       SET DIE="^DVB(396.6,"

 +8                    SET DR=".07///"_WKS_";.5///"_STAT_";2///"_BDY_";6///"_PNM_";7///"_ROU_";.01///"_NAME

 +9                    DO ^DIE

 +10                   KILL DIE,DA,DR

                   End DoDot:1

 +11       IF '$DATA(^DVB(396.6,EN))

               DO MES^XPDUTL("Unable to add exam, "_NAME_", IEN= ",EN)

 +12       KILL DIC,X,Y,DINUM

 +13       QUIT