- LRUPUM ; IHS/DIR/FJE - USER MANUAL 13:31 ; [ 3/9/94 ]
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- D END S DIC="^LAB(68.45,",DIC(0)="AEQM" D ^DIC K DIC G:Y<1 END S LRI=+Y,LRN=$P(Y,U,2)
- I '$O(^LAB(68.45,LRI,1,0)) W $C(7),!,"No data elements selected for ",LRN G END
- S ZTRTN="QUE^LRUPUM" D BEG^LRUTL Q:POP!($D(ZTSK))
- QUE U IO S DIWL=10,DIWR=IOM-5,LRL=DIWR-DIWL-5,DIWF="W",(LR("Q"),LR("F"),LRQ)=0,LRQ(1)=^DD("SITE") D L^LRU D H S LR("F")=1
- F LRA=0:0 S LRA=$O(^LAB(68.45,LRI,1,LRA)) Q:'LRA D:$Y>(IOSL-5) H Q:LR("Q") S LRE=^(LRA,0),LRX=$P(LRE,","),LRY=$P(LRE,",",2) I LRX]"",LRY]"" D W
- D END,END^LRUTL Q
- W S X=$S($D(^DD(LRX,LRY,0)):^(0),1:"") Q:X="" W !,LRE,?16,$P(X,"^") I $P(X,"^",2)["S" S LRD=$P(X,"^",3),LRC=";" D B
- F LRO=3,12 S LRD=$S($D(^DD(LRX,LRY,LRO)):^(LRO),1:""),LRC=" " I LRD]"" D B
- K ^TMP($J) S LRB=0 F LRZ=0:1 S LRB=$O(^DD(LRX,LRY,21,LRB)) Q:'LRB D:$Y>(IOSL-5) H1 Q:LR("Q") S X=^DD(LRX,LRY,21,LRB,0) D ^DIWP
- Q:LR("Q") D:LRZ ^DIWW Q
- B Q:LR("Q") I $L(LRD)<LRL W !?DIWL-1,LRD,! W:LRC=" " ! D:$Y>(IOSL-6) H1 Q
- S LRK="",Z=1 F %=1:1 Q:'$L(LRD) D:$L(LRK)>LRL C S:LRK]"" LRK=LRK_LRC S LRK=LRK_$P(LRD,LRC),LRD=$P(LRD,LRC,2,99),Z=Z+1
- W:LRK]"" !?DIWL-1,LRK,! W:LRC=" " ! Q
- C S LRK=$P(LRK,LRC,1,Z) D:$Y>(IOSL-6) H1 Q:LR("Q") W !?DIWL-1,LRK S Z=1,LRK="" Q
- ;
- H Q:LR("Q") I IOST?1"C".E,LR("F") D M^LRU Q:LR("Q")
- S LRQ=LRQ+1,X="N",%DT="T" D ^%DT,D^LRU W @IOF,!,Y,?25,LRQ(1),?73,"Pg ",LRQ,!,"DATA ELEMENTS FOR ",LRN,!,LR("%") Q
- ;
- H1 D H Q:LR("Q") W !,LRE,?16,$P(^DD(LRX,LRY,0),"^")," (Continued)" Q
- ;
- EN ;Edit USER GROUP MANUAL file
- D END W ! S (DIC,DIE)="^LAB(68.45,",DIC(0)="AEQLM",DLAYGO=68
- D ^DIC K DIC G:Y<1 END S DA=+Y,DR=".01:99" D ^DIE K DLAYGO G EN
- ;
- END D V^LRU Q
- LRUPUM ; IHS/DIR/FJE - USER MANUAL 13:31 ; [ 3/9/94 ]
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 DO END
- SET DIC="^LAB(68.45,"
- SET DIC(0)="AEQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO END
- SET LRI=+Y
- SET LRN=$PIECE(Y,U,2)
- +5 IF '$ORDER(^LAB(68.45,LRI,1,0))
- WRITE $CHAR(7),!,"No data elements selected for ",LRN
- GOTO END
- +6 SET ZTRTN="QUE^LRUPUM"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- QUIT
- QUE USE IO
- SET DIWL=10
- SET DIWR=IOM-5
- SET LRL=DIWR-DIWL-5
- SET DIWF="W"
- SET (LR("Q"),LR("F"),LRQ)=0
- SET LRQ(1)=^DD("SITE")
- DO L^LRU
- DO H
- SET LR("F")=1
- +1 FOR LRA=0:0
- SET LRA=$ORDER(^LAB(68.45,LRI,1,LRA))
- IF 'LRA
- QUIT
- IF $Y>(IOSL-5)
- DO H
- IF LR("Q")
- QUIT
- SET LRE=^(LRA,0)
- SET LRX=$PIECE(LRE,",")
- SET LRY=$PIECE(LRE,",",2)
- IF LRX]""
- IF LRY]""
- DO W
- +2 DO END
- DO END^LRUTL
- QUIT
- W SET X=$SELECT($DATA(^DD(LRX,LRY,0)):^(0),1:"")
- IF X=""
- QUIT
- WRITE !,LRE,?16,$PIECE(X,"^")
- IF $PIECE(X,"^",2)["S"
- SET LRD=$PIECE(X,"^",3)
- SET LRC=";"
- DO B
- +1 FOR LRO=3,12
- SET LRD=$SELECT($DATA(^DD(LRX,LRY,LRO)):^(LRO),1:"")
- SET LRC=" "
- IF LRD]""
- DO B
- +2 KILL ^TMP($JOB)
- SET LRB=0
- FOR LRZ=0:1
- SET LRB=$ORDER(^DD(LRX,LRY,21,LRB))
- IF 'LRB
- QUIT
- IF $Y>(IOSL-5)
- DO H1
- IF LR("Q")
- QUIT
- SET X=^DD(LRX,LRY,21,LRB,0)
- DO ^DIWP
- +3 IF LR("Q")
- QUIT
- IF LRZ
- DO ^DIWW
- QUIT
- B IF LR("Q")
- QUIT
- IF $LENGTH(LRD)<LRL
- WRITE !?DIWL-1,LRD,!
- IF LRC=" "
- WRITE !
- IF $Y>(IOSL-6)
- DO H1
- QUIT
- +1 SET LRK=""
- SET Z=1
- FOR %=1:1
- IF '$LENGTH(LRD)
- QUIT
- IF $LENGTH(LRK)>LRL
- DO C
- IF LRK]""
- SET LRK=LRK_LRC
- SET LRK=LRK_$PIECE(LRD,LRC)
- SET LRD=$PIECE(LRD,LRC,2,99)
- SET Z=Z+1
- +2 IF LRK]""
- WRITE !?DIWL-1,LRK,!
- IF LRC=" "
- WRITE !
- QUIT
- C SET LRK=$PIECE(LRK,LRC,1,Z)
- IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !?DIWL-1,LRK
- SET Z=1
- SET LRK=""
- QUIT
- +1 ;
- H IF LR("Q")
- QUIT
- IF IOST?1"C".E
- IF LR("F")
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 SET LRQ=LRQ+1
- SET X="N"
- SET %DT="T"
- DO ^%DT
- DO D^LRU
- WRITE @IOF,!,Y,?25,LRQ(1),?73,"Pg ",LRQ,!,"DATA ELEMENTS FOR ",LRN,!,LR("%")
- QUIT
- +2 ;
- H1 DO H
- IF LR("Q")
- QUIT
- WRITE !,LRE,?16,$PIECE(^DD(LRX,LRY,0),"^")," (Continued)"
- QUIT
- +1 ;
- EN ;Edit USER GROUP MANUAL file
- +1 DO END
- WRITE !
- SET (DIC,DIE)="^LAB(68.45,"
- SET DIC(0)="AEQLM"
- SET DLAYGO=68
- +2 DO ^DIC
- KILL DIC
- IF Y<1
- GOTO END
- SET DA=+Y
- SET DR=".01:99"
- DO ^DIE
- KILL DLAYGO
- GOTO EN
- +3 ;
- END DO V^LRU
- QUIT
