MDPSUL ; HOIFO/NCA - HS Component Utility;5/18/04 09:48 ;10/5/09 09:33
;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
; Integration Agreements:
; IA# 10103 [Supported] XLFDT calls
;
EN2 ; Print the List of Components that should be created in HS
N DIC,MDSPEC,X,Y,DTOUT,DUOUT
K IOP S %ZIS="MQ",%ZIS("A")="Select LIST Printer: ",%ZIS("B")="HOME" W ! D ^%ZIS K %ZIS,IOP Q:POP
I $D(IO("Q")) D QUE Q
U IO D GETLIST D ^%ZISC K %ZIS,IOP Q
QUE ; Queue List
K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE,ZTDESC,ZTSK S ZTRTN="GETLIST^MDPSUL",ZTREQ="@",ZTSAVE("ZTREQ")=""
S ZTDESC="Print the List of Components that should be created in HS."
D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",! K ZTSK Q
EX ; Exit
Q
GETLIST ; [Procedure] Loop through Instruments and get active list
N ANS,DTP,LN,MDLL,MDX,PG,S1
S S1=$S(IOST?1"C".E:IOSL-8,1:IOSL-7)
S (ANS,LN)="",$P(LN,"-",57)=""
S PG=0 N % D NOW^%DTC S DTP=%,DTP=$$FMTE^XLFDT(DTP,"1P") D HDR
F MDLL=0:0 S MDLL=$O(^MDS(702.09,MDLL)) Q:MDLL<1!(ANS="^") S MDX=$G(^(MDLL,0)) D
.Q:'$P(MDX,"^",9)
.Q:'$P($G(^MDS(702.09,MDLL,.1)),"^",3)
.D:$Y>(IOSL-8) HDR Q:ANS="^"
.W !,$E($P(MDX,"^"),1,25),?27,"CPF;MDPSU",?50,"M",MDLL
Q
HDR ; List Header
Q:ANS="^" D:$Y'<S1 PAUSE Q:ANS="^"
W:'($E(IOST,1,2)'="C-"&'PG) @IOF S PG=PG+1
W !,DTP,?52,"Page ",PG,!!?10,"LIST OF HS COMPONENTS NEEDED",!!
W !,"Name",?27,"Print Routine",?45,"Abbreviation",!,LN
Q
PAUSE ; Pause For Scroll
I IOST?1"C".E K DIR S DIR(0)="E",DIR("A")="Enter RETURN to Continue or '^' to Quit Listing" D ^DIR I 'Y S ANS="^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDPSUL 1577 printed Apr 09, 2024@20:47:30 Page 2
MDPSUL ; HOIFO/NCA - HS Component Utility;5/18/04 09:48 ;10/5/09 09:33
+1 ;;1.0;CLINICAL PROCEDURES;**21**;Apr 01, 2004;Build 30
+2 ; Integration Agreements:
+3 ; IA# 10103 [Supported] XLFDT calls
+4 ;
EN2 ; Print the List of Components that should be created in HS
+1 NEW DIC,MDSPEC,X,Y,DTOUT,DUOUT
+2 KILL IOP
SET %ZIS="MQ"
SET %ZIS("A")="Select LIST Printer: "
SET %ZIS("B")="HOME"
WRITE !
DO ^%ZIS
KILL %ZIS,IOP
if POP
QUIT
+3 IF $DATA(IO("Q"))
DO QUE
QUIT
+4 USE IO
DO GETLIST
DO ^%ZISC
KILL %ZIS,IOP
QUIT
QUE ; Queue List
+1 KILL IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE,ZTDESC,ZTSK
SET ZTRTN="GETLIST^MDPSUL"
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+2 SET ZTDESC="Print the List of Components that should be created in HS."
+3 DO ^%ZTLOAD
DO ^%ZISC
USE IO
WRITE !,"Request Queued",!
KILL ZTSK
QUIT
EX ; Exit
+1 QUIT
GETLIST ; [Procedure] Loop through Instruments and get active list
+1 NEW ANS,DTP,LN,MDLL,MDX,PG,S1
+2 SET S1=$SELECT(IOST?1"C".E:IOSL-8,1:IOSL-7)
+3 SET (ANS,LN)=""
SET $PIECE(LN,"-",57)=""
+4 SET PG=0
NEW %
DO NOW^%DTC
SET DTP=%
SET DTP=$$FMTE^XLFDT(DTP,"1P")
DO HDR
+5 FOR MDLL=0:0
SET MDLL=$ORDER(^MDS(702.09,MDLL))
if MDLL<1!(ANS="^")
QUIT
SET MDX=$GET(^(MDLL,0))
Begin DoDot:1
+6 if '$PIECE(MDX,"^",9)
QUIT
+7 if '$PIECE($GET(^MDS(702.09,MDLL,.1)),"^",3)
QUIT
+8 if $Y>(IOSL-8)
DO HDR
if ANS="^"
QUIT
+9 WRITE !,$EXTRACT($PIECE(MDX,"^"),1,25),?27,"CPF;MDPSU",?50,"M",MDLL
End DoDot:1
+10 QUIT
HDR ; List Header
+1 if ANS="^"
QUIT
if $Y'<S1
DO PAUSE
if ANS="^"
QUIT
+2 if '($EXTRACT(IOST,1,2)'="C-"&'PG)
WRITE @IOF
SET PG=PG+1
+3 WRITE !,DTP,?52,"Page ",PG,!!?10,"LIST OF HS COMPONENTS NEEDED",!!
+4 WRITE !,"Name",?27,"Print Routine",?45,"Abbreviation",!,LN
+5 QUIT
PAUSE ; Pause For Scroll
+1 IF IOST?1"C".E
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue or '^' to Quit Listing"
DO ^DIR
IF 'Y
SET ANS="^"
+2 QUIT
