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