- 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 Feb 18, 2025@23:43:02 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