MCPOS08.m

MCPOS08 ;HIRMFO/DAD-PUT CARDIOLOGY CODE INTO MULT IN 695 ;4/26/96  14:51

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

 ;

 N MCD0,MCDATA,DD,DIC,DINUM,DO

 ;

 S MCDATA(1)=""

 S MCDATA(2)="Adding the cardiology code to the Medical Package Use"

 S MCDATA(3)="multiple in the Medication file (#695)"

 D MES^XPDUTL(.MCDATA)

 ;

 I $D(^MCAR(695,"C")) Q

 ;

 S MCD0=0

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

 . I $O(^MCAR(695,"C","C",MCD0,0)) Q

 . K DD,DIC,DINUM,DO

 . S DIC="^MCAR(695,"_MCD0_",1,",DIC(0)="L"

 . S DIC("P")=$$GET1^DID(695,1,"","SPECIFIER")

 . S DLAYGO=695,(D0,DA(1))=MCD0,X="C"

 . D FILE^DICN

 . Q

 Q

MCPOS08   ;HIRMFO/DAD-PUT CARDIOLOGY CODE INTO MULT IN 695 ;4/26/96  14:51

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

 +2       ;

 +3        NEW MCD0,MCDATA,DD,DIC,DINUM,DO

 +4       ;

 +5        SET MCDATA(1)=""

 +6        SET MCDATA(2)="Adding the cardiology code to the Medical Package Use"

 +7        SET MCDATA(3)="multiple in the Medication file (#695)"

 +8        DO MES^XPDUTL(.MCDATA)

 +9       ;

 +10       IF $DATA(^MCAR(695,"C"))

               QUIT 

 +11      ;

 +12       SET MCD0=0

 +13       FOR 

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

               IF MCD0'>0

                   QUIT 

               Begin DoDot:1

 +14               IF $ORDER(^MCAR(695,"C","C",MCD0,0))

                       QUIT 

 +15               KILL DD,DIC,DINUM,DO

 +16               SET DIC="^MCAR(695,"_MCD0_",1,"

                   SET DIC(0)="L"

 +17               SET DIC("P")=$$GET1^DID(695,1,"","SPECIFIER")

 +18               SET DLAYGO=695

                   SET (D0,DA(1))=MCD0

                   SET X="C"

 +19               DO FILE^DICN

 +20               QUIT 

               End DoDot:1

 +21       QUIT