- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORUDPA 1409 printed Feb 19, 2025@00:00:58 Page 2
- 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