LRAPPA.m

LRAPPA ; IHS/DIR/AAB - CY/EM/SP PATIENT RPT 8/12/95 08:15 ;

 ;;5.2;LR;**1002**;JUN 01, 1998

 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 S LRDICS="SPCYEM" D ^LRAP G:'$D(Y) END

 S X="T",%DT="" D ^%DT S LR("Y")=$E(Y,1,3)+1700,IOP="HOME" D ^%ZIS

 W !!?20,LRAA(1)," FINAL PATIENT REPORTS DISPLAY" K LRSAV,LRAP,LRS(99) D EN2^LRUA

 S %DT("A")="Enter year: ",%DT("B")=LR("Y"),%DT="AEQ" D ^%DT G:Y<1 END S LR("Y")=$E(Y,1,3)

A1 R !,"Start with accession #: ",X:DTIME G:X=""!(X[U) END I X<1!(X>99999) W $C(7),!,"Enter a number from 1 to 99999" G A1

 S LR("B")=X

A2 R !,"Go to accession #: ",X:DTIME G:X=""!(X[U) END I X<1!(X>99999) W $C(7),!,"Enter a number from 1 to 99999" G A2

 S LR("E")=X I LR("B")>LR("E") S X=LR("B"),LR("B")=LR("E"),LR("E")=X

 S LR("B")=LR("B")-1

 S LRA(2)=0,LRA=1 D L^LRU,S^LRU,SET^LRUA,XR^LRU I IO=IO(0) S DIWL=3,DIWR=IOM-3,DIWF="W"

 F LRAN=LR("B"):0 S LRAN=$O(^LR(LRXREF,LR("Y"),LRABV,LRAN)) Q:'LRAN!(LRAN>LR("E"))!(LRA(2)?1P)  S LRDFN=$O(^(LRAN,0)),LRI=$O(^(LRDFN,0)) D @$S(IO'=IO(0):"EN^LRSPRPT",1:"D") Q:LRA(2)?1P

 W @IOF D END^LRUTL,END Q

 ;

D ;W @IOF S (A,LRA(2))=0,LRA(1)=$Y+21,B=^LR(LRDFN,LRSS,LRI,0),X=^LR(LRDFN,0),Y=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)") W !,$P(X,"^"),?38,"SSN: ",$P(X,"^",9) D E^LRAPCUM,W^LRAPCUM Q

 W @IOF S (A,LRA(2))=0,LRA(1)=$Y+21,B=^LR(LRDFN,LRSS,LRI,0),X=^LR(LRDFN,0),(DFN,Y)=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)") D SSN^LRU W !,$P(X,"^"),?38,"HRCN: ",HRCN D E^LRAPCUM,W^LRAPCUM Q  ;IHS/ANMC/CLS 11/1/95

END D V^LRU Q

LRAPPA    ; IHS/DIR/AAB - CY/EM/SP PATIENT RPT 8/12/95 08:15 ;

 +1       ;;5.2;LR;**1002**;JUN 01, 1998

 +2       ;;5.2;LAB SERVICE;**72**;Sep 27, 1994

 +3        SET LRDICS="SPCYEM"

           DO ^LRAP

           IF '$DATA(Y)

               GOTO END

 +4        SET X="T"

           SET %DT=""

           DO ^%DT

           SET LR("Y")=$EXTRACT(Y,1,3)+1700

           SET IOP="HOME"

           DO ^%ZIS

 +5        WRITE !!?20,LRAA(1)," FINAL PATIENT REPORTS DISPLAY"

           KILL LRSAV,LRAP,LRS(99)

           DO EN2^LRUA

 +6        SET %DT("A")="Enter year: "

           SET %DT("B")=LR("Y")

           SET %DT="AEQ"

           DO ^%DT

           IF Y<1

               GOTO END

           SET LR("Y")=$EXTRACT(Y,1,3)

A1         READ !,"Start with accession #: ",X:DTIME

           IF X=""!(X[U)

               GOTO END

           IF X<1!(X>99999)

               WRITE $CHAR(7),!,"Enter a number from 1 to 99999"

               GOTO A1

 +1        SET LR("B")=X

A2         READ !,"Go to accession #: ",X:DTIME

           IF X=""!(X[U)

               GOTO END

           IF X<1!(X>99999)

               WRITE $CHAR(7),!,"Enter a number from 1 to 99999"

               GOTO A2

 +1        SET LR("E")=X

           IF LR("B")>LR("E")

               SET X=LR("B")

               SET LR("B")=LR("E")

               SET LR("E")=X

 +2        SET LR("B")=LR("B")-1

 +3        SET LRA(2)=0

           SET LRA=1

           DO L^LRU

           DO S^LRU

           DO SET^LRUA

           DO XR^LRU

           IF IO=IO(0)

               SET DIWL=3

               SET DIWR=IOM-3

               SET DIWF="W"

 +4        FOR LRAN=LR("B"):0

               SET LRAN=$ORDER(^LR(LRXREF,LR("Y"),LRABV,LRAN))

               IF 'LRAN!(LRAN>LR("E"))!(LRA(2)?1P)

                   QUIT 

               SET LRDFN=$ORDER(^(LRAN,0))

               SET LRI=$ORDER(^(LRDFN,0))

               DO @$SELECT(IO'=IO(0):"EN^LRSPRPT",1:"D")

               IF LRA(2)?1P

                   QUIT 

 +5        WRITE @IOF

           DO END^LRUTL

           DO END

           QUIT 

 +6       ;

D         ;W @IOF S (A,LRA(2))=0,LRA(1)=$Y+21,B=^LR(LRDFN,LRSS,LRI,0),X=^LR(LRDFN,0),Y=$P(X,"^",3),X=$P(X,"^",2),X=^DIC(X,0,"GL"),X=@(X_Y_",0)") W !,$P(X,"^"),?38,"SSN: ",$P(X,"^",9) D E^LRAPCUM,W^LRAPCUM Q

 +1       ;IHS/ANMC/CLS 11/1/95

           WRITE @IOF

           SET (A,LRA(2))=0

           SET LRA(1)=$Y+21

           SET B=^LR(LRDFN,LRSS,LRI,0)

           SET X=^LR(LRDFN,0)

           SET (DFN,Y)=$PIECE(X,"^",3)

           SET X=$PIECE(X,"^",2)

           SET X=^DIC(X,0,"GL")

           SET X=@(X_Y_",0)")

           DO SSN^LRU

           WRITE !,$PIECE(X,"^"),?38,"HRCN: ",HRCN

           DO E^LRAPCUM

           DO W^LRAPCUM

           QUIT 

END        DO V^LRU

           QUIT