ORUDPA.m

ORUDPA ; slc/dcm,RWF - Object (patient) lookup ;10/7/91  15:21 ; 3/7/08 5:22am

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,243**;Dec 17, 1997;Build 242

ENT ;

 ;Entry: none  Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR

 D PATIENT^ORU1(.Y)

 Q

EN2 ;

 S (ORVP,X)="",DIC(0)="EMQZI",DIC=2

 R !,"Select PATIENT NAME: ",X:DTIME

 I X=""!(X["^") S Y=-1 G END1

 S:'$D(DIC(0)) DIC(0)="EMQZI"

 S DIC="^DPT(" D ^DIC I $E(X)="^" S:X="^^" DIROUT=1 G END1

 I Y>0 S ORVP=+Y_";DPT(" Q:$D(ORUS)  G END1

 Q

END1 ;

 I Y>0 S ^TMP("OR",$J,"PAT",1)=ORVP,^TMP("OR",$J,"PAT","B",ORVP,1)=""

END ;from ORUHDR

 Q:Y<0

 I ORVP[";DPT(" D HOMO

 K VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC Q

 ;

GPD ;

 N GMRVSTR

 K ORPD

 S (ORSEQ,ORPD)=0,DFN=+ORVP

 I $D(^GMRD(120.51)) S X="GMRVUTL",GMRVSTR="WT" X ^%ZOSF("TEST") I $T D EN6^GMRVUTL S ORPD=+$P(X,U,8)\1

 S:ORPD'>0 ORPD="NF"

 K ORSEQ

 Q

HOMO ;

 N XQORFLG,ORCNV

 S DFN=+Y,VA200=1 K VAINDT

 D OERR^VADPT,GPD

 S ORPNM=VADM(1),ORSSN=VA("PID"),ORDOB=$P(VADM(3),"^",2),ORAGE=VADM(4),ORSEX=$P(VADM(5),"^"),ORTS=+VAIN(3),ORTS=$S(ORTS:ORTS,1:""),(ORATTEND,ORNP)=+VAIN(2),ORWARD=VAIN(4),ORL(1)=VAIN(5),(ORPV,ORL,ORL(0),ORL(2))=""

 I +$P(ORWARD,"^") S X=+ORWARD I $D(^DIC(42,+X,44)) S X=$P(^(44),"^") I X,$D(^SC(X,0)) S ORL=X_";SC(",ORL(0)=$S($L($P(^(0),"^",2)):$P(^(0),"^",2),1:$E($P(^(0),"^"),1,4)),ORL(2)=ORL

 Q

ORUDPA    ; slc/dcm,RWF - Object (patient) lookup ;10/7/91  15:21 ; 3/7/08 5:22am

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**16,243**;Dec 17, 1997;Build 242

ENT       ;

 +1       ;Entry: none  Exit: DFN,ORACTION,ORAGE,ORDOB,ORL,ORNP,ORPD,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORVP,ORWARD,VADPT("V"),VAERR

 +2        DO PATIENT^ORU1(.Y)

 +3        QUIT 

EN2       ;

 +1        SET (ORVP,X)=""

           SET DIC(0)="EMQZI"

           SET DIC=2

 +2        READ !,"Select PATIENT NAME: ",X:DTIME

 +3        IF X=""!(X["^")

               SET Y=-1

               GOTO END1

 +4        IF '$DATA(DIC(0))

               SET DIC(0)="EMQZI"

 +5        SET DIC="^DPT("

           DO ^DIC

           IF $EXTRACT(X)="^"

               IF X="^^"

                   SET DIROUT=1

               GOTO END1

 +6        IF Y>0

               SET ORVP=+Y_";DPT("

               IF $DATA(ORUS)

                   QUIT 

               GOTO END1

 +7        QUIT 

END1      ;

 +1        IF Y>0

               SET ^TMP("OR",$JOB,"PAT",1)=ORVP

               SET ^TMP("OR",$JOB,"PAT","B",ORVP,1)=""

END       ;from ORUHDR

 +1        IF Y<0

               QUIT 

 +2        IF ORVP[";DPT("

               DO HOMO

 +3        KILL VA,VAROOT,VA200,VAIN,VAINDT,VAERR,VADM,DIC

           QUIT 

 +4       ;

GPD       ;

 +1        NEW GMRVSTR

 +2        KILL ORPD

 +3        SET (ORSEQ,ORPD)=0

           SET DFN=+ORVP

 +4        IF $DATA(^GMRD(120.51))

               SET X="GMRVUTL"

               SET GMRVSTR="WT"

               XECUTE ^%ZOSF("TEST")

               IF $TEST

                   DO EN6^GMRVUTL

                   SET ORPD=+$PIECE(X,U,8)\1

 +5        IF ORPD'>0

               SET ORPD="NF"

 +6        KILL ORSEQ

 +7        QUIT 

HOMO      ;

 +1        NEW XQORFLG,ORCNV

 +2        SET DFN=+Y

           SET VA200=1

           KILL VAINDT

 +3        DO OERR^VADPT

           DO GPD

 +4        SET ORPNM=VADM(1)

           SET ORSSN=VA("PID")

           SET ORDOB=$PIECE(VADM(3),"^",2)

           SET ORAGE=VADM(4)

           SET ORSEX=$PIECE(VADM(5),"^")

           SET ORTS=+VAIN(3)

           SET ORTS=$SELECT(ORTS:ORTS,1:"")

           SET (ORATTEND,ORNP)=+VAIN(2)

           SET ORWARD=VAIN(4)

           SET ORL(1)=VAIN(5)

           SET (ORPV,ORL,ORL(0),ORL(2))=""

 +5        IF +$PIECE(ORWARD,"^")

               SET X=+ORWARD

               IF $DATA(^DIC(42,+X,44))

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

                   IF X

                       IF $DATA(^SC(X,0))

                           SET ORL=X_";SC("

                           SET ORL(0)=$SELECT($LENGTH($PIECE(^(0),"^",2)):$PIECE(^(0),"^",2),1:$EXTRACT($PIECE(^(0),"^"),1,4))

                           SET ORL(2)=ORL

 +6        QUIT