GMRCPOR ;SLC/DCM,DLT - Get DOC,LOC,TS in interactive defaults ;5/20/98 14:20
;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
DEM ;Similiar to load of variables done by ORUDPA
;;Call from ^GMRCR0
S ORVP=DFN_";DPT(",VA200=1
K VAINDT D OERR^VADPT S GMRCPNM=VADM(1),GMRCSN=VA("PID"),GMRCDOB=$P(VADM(3),"^",2),GMRCAGE=VADM(4),SEX=$P(VADM(5),"^")
S ORTS=+VAIN(3),ORTS=$S(ORTS:ORTS,1:""),ORNP=+VAIN(2),ORWARD=VAIN(4),GMRCWARD=$P(VAIN(4),"^",2),(GMRCRB,ORL(1))=VAIN(5),(ORL,ORL(0),ORL(2))=""
I ORNP,'$D(^VA(200,ORNP,0)) S ORNP=""
S ORPV="" I ORNP,$D(^XUSEC("PROVIDER",ORNP)) S ORPV=ORNP
S ORATTEND=ORNP
I $P(ORWARD,"^")?1N.N 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
D DOC,LOC,DOC1
K O,ORL(0),DIC,VA,VAIN,VADM,VAERR,Y
Q
DOC ;Get the requesting clinician
S DOC=""
I ORNP,$D(^VA(200,+ORNP,0)) S X=$P(^(0),"^") S:$P(^ORD(100.99,1,0),"^",15) DOC=X
I $D(ORATTEND),$D(^VA(200,+ORATTEND,0)) S X=$P(^(0),"^") W !!,"Primary Care Physician is "_X,!
Q
DOC1 ;Display Requesting Clinician
W !,?5,"Requesting CLINICIAN : ",$S($L(DOC):DOC,1:"****** missing required information ******")
Q
LOC ;GET PT. LOCATION
D INP^VADPT,SDE^VADPT
D:$L(VAIN(4)) LOC1 S (CT,C)=0,O=1 I $O(^UTILITY("VAEN",$J,0)) W !!,"Currently enrolled in the following clinics: ",!
S I=0 F S I=$O(^UTILITY("VAEN",$J,I)) Q:I'>0 S CT=CT+1 W:(CT#2) !?17 W:'(CT#2) ?47 W $P(^UTILITY("VAEN",$J,I,"E"),"^") S C=C+1,C(1)=$P(^("E"),"^") S:C'=1 C=-1
K I,VAIN
Q
LOC1 ;Check for patient location
W !!,?5,"Patient Location : "_$P(VAIN(4),"^",2) I '$L(VAIN(4)) W "****** missing required information ******"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPOR 1727 printed Sep 23, 2025@19:22:44 Page 2
GMRCPOR ;SLC/DCM,DLT - Get DOC,LOC,TS in interactive defaults ;5/20/98 14:20
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
DEM ;Similiar to load of variables done by ORUDPA
+1 ;;Call from ^GMRCR0
+2 SET ORVP=DFN_";DPT("
SET VA200=1
+3 KILL VAINDT
DO OERR^VADPT
SET GMRCPNM=VADM(1)
SET GMRCSN=VA("PID")
SET GMRCDOB=$PIECE(VADM(3),"^",2)
SET GMRCAGE=VADM(4)
SET SEX=$PIECE(VADM(5),"^")
+4 SET ORTS=+VAIN(3)
SET ORTS=$SELECT(ORTS:ORTS,1:"")
SET ORNP=+VAIN(2)
SET ORWARD=VAIN(4)
SET GMRCWARD=$PIECE(VAIN(4),"^",2)
SET (GMRCRB,ORL(1))=VAIN(5)
SET (ORL,ORL(0),ORL(2))=""
+5 IF ORNP
IF '$DATA(^VA(200,ORNP,0))
SET ORNP=""
+6 SET ORPV=""
IF ORNP
IF $DATA(^XUSEC("PROVIDER",ORNP))
SET ORPV=ORNP
+7 SET ORATTEND=ORNP
+8 IF $PIECE(ORWARD,"^")?1N.N
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
+9 DO DOC
DO LOC
DO DOC1
+10 KILL O,ORL(0),DIC,VA,VAIN,VADM,VAERR,Y
+11 QUIT
DOC ;Get the requesting clinician
+1 SET DOC=""
+2 IF ORNP
IF $DATA(^VA(200,+ORNP,0))
SET X=$PIECE(^(0),"^")
if $PIECE(^ORD(100.99,1,0),"^",15)
SET DOC=X
+3 IF $DATA(ORATTEND)
IF $DATA(^VA(200,+ORATTEND,0))
SET X=$PIECE(^(0),"^")
WRITE !!,"Primary Care Physician is "_X,!
+4 QUIT
DOC1 ;Display Requesting Clinician
+1 WRITE !,?5,"Requesting CLINICIAN : ",$SELECT($LENGTH(DOC):DOC,1:"****** missing required information ******")
+2 QUIT
LOC ;GET PT. LOCATION
+1 DO INP^VADPT
DO SDE^VADPT
+2 if $LENGTH(VAIN(4))
DO LOC1
SET (CT,C)=0
SET O=1
IF $ORDER(^UTILITY("VAEN",$JOB,0))
WRITE !!,"Currently enrolled in the following clinics: ",!
+3 SET I=0
FOR
SET I=$ORDER(^UTILITY("VAEN",$JOB,I))
if I'>0
QUIT
SET CT=CT+1
if (CT#2)
WRITE !?17
if '(CT#2)
WRITE ?47
WRITE $PIECE(^UTILITY("VAEN",$JOB,I,"E"),"^")
SET C=C+1
SET C(1)=$PIECE(^("E"),"^")
if C'=1
SET C=-1
+4 KILL I,VAIN
+5 QUIT
LOC1 ;Check for patient location
+1 WRITE !!,?5,"Patient Location : "_$PIECE(VAIN(4),"^",2)
IF '$LENGTH(VAIN(4))
WRITE "****** missing required information ******"
+2 QUIT
