- 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 Mar 13, 2025@20:48:37 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
