MCPOS0E.m

MCPOS0E ;HIRMFO/DAD-RESTORE LOCALLY DEFINED PROCEDURES TO THE MED VIEW FILE ;8/21/96  11:57

 ;;2.3;Medicine;;09/13/1996

 ;

 N D0,DA,DD,DIC,DINUM,DLAYGO,DO,MCD0,MCDATA,MCGENRIC,MCOUNT

 N MCPROCSP,MCTYPE

 S MCDATA(1)=""

 S MCDATA(2)="Restoring locally defined procedures to the"

 S MCDATA(3)="Medicine View file (#690.2)"

 ;

 S MCPROCSP=$$GET1^DID(690.2,4,"","SPECIFIER"),MCOUNT=4

 F MCGENRIC=1,2 D

 . S MCTYPE=$P("Full^Brief",U,MCGENRIC)_" Generic"

 . S MCGENRIC(MCGENRIC)=+$O(^MCAR(690.2,"B",MCTYPE,0))

 . I MCGENRIC(MCGENRIC)'>0 D

 .. S MCDATA(MCOUNT)="  '"_MCTYPE_"' not found in the Medicine View file"

 .. S MCOUNT=MCOUNT+1

 .. Q

 . Q

 D MES^XPDUTL(.MCDATA)

 ;

 S MCD0=0

 F  S MCD0=$O(^MCAR(697.2,MCD0)) Q:MCD0'>0  D

 . I $P($G(^MCAR(697.2,MCD0,0)),U,19)'>0 Q

 . F MCGENRIC=1,2 I MCGENRIC(MCGENRIC) D

 .. I $O(^MCAR(690.2,MCGENRIC(MCGENRIC),3,"B",MCD0,0)) Q

 .. K DD,DIC,DINUM,DO

 .. S X=MCD0,DIC="^MCAR(690.2,"_MCGENRIC(MCGENRIC)_",3,",DIC(0)="L"

 .. S DIC("P")=MCPROCSP,DLAYGO=690.2,(D0,DA(1))=MCGENRIC(MCGENRIC)

 .. D FILE^DICN

 .. Q

 . Q

 Q

MCPOS0E   ;HIRMFO/DAD-RESTORE LOCALLY DEFINED PROCEDURES TO THE MED VIEW FILE ;8/21/96  11:57

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3        NEW D0,DA,DD,DIC,DINUM,DLAYGO,DO,MCD0,MCDATA,MCGENRIC,MCOUNT

 +4        NEW MCPROCSP,MCTYPE

 +5        SET MCDATA(1)=""

 +6        SET MCDATA(2)="Restoring locally defined procedures to the"

 +7        SET MCDATA(3)="Medicine View file (#690.2)"

 +8       ;

 +9        SET MCPROCSP=$$GET1^DID(690.2,4,"","SPECIFIER")

           SET MCOUNT=4

 +10       FOR MCGENRIC=1,2

               Begin DoDot:1

 +11               SET MCTYPE=$PIECE("Full^Brief",U,MCGENRIC)_" Generic"

 +12               SET MCGENRIC(MCGENRIC)=+$ORDER(^MCAR(690.2,"B",MCTYPE,0))

 +13               IF MCGENRIC(MCGENRIC)'>0

                       Begin DoDot:2

 +14                       SET MCDATA(MCOUNT)="  '"_MCTYPE_"' not found in the Medicine View file"

 +15                       SET MCOUNT=MCOUNT+1

 +16                       QUIT 

                       End DoDot:2

 +17               QUIT 

               End DoDot:1

 +18       DO MES^XPDUTL(.MCDATA)

 +19      ;

 +20       SET MCD0=0

 +21       FOR 

               SET MCD0=$ORDER(^MCAR(697.2,MCD0))

               IF MCD0'>0

                   QUIT 

               Begin DoDot:1

 +22               IF $PIECE($GET(^MCAR(697.2,MCD0,0)),U,19)'>0

                       QUIT 

 +23               FOR MCGENRIC=1,2

                       IF MCGENRIC(MCGENRIC)

                           Begin DoDot:2

 +24                           IF $ORDER(^MCAR(690.2,MCGENRIC(MCGENRIC),3,"B",MCD0,0))

                                   QUIT 

 +25                           KILL DD,DIC,DINUM,DO

 +26                           SET X=MCD0

                               SET DIC="^MCAR(690.2,"_MCGENRIC(MCGENRIC)_",3,"

                               SET DIC(0)="L"

 +27                           SET DIC("P")=MCPROCSP

                               SET DLAYGO=690.2

                               SET (D0,DA(1))=MCGENRIC(MCGENRIC)

 +28                           DO FILE^DICN

 +29                           QUIT 

                           End DoDot:2

 +30               QUIT 

               End DoDot:1

 +31       QUIT