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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS08 616 printed Dec 13, 2024@02:16:29 Page 2
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
