- GMRCPOR ;SLC/DCM,DLT - Get DOC,LOC,TS in interactive defaults ;15-Mar-2012 10:40;PLS
- ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14
- ;Modified - IHS/CIA/MGH - 11/29/2005 - Line DEM+5
- DEM ;Similiar to load of variables done by ORUDPA
- ;;Call from ^GMRCR0
- ;IHS/CIA/MGH Added code to use HRCN instead of SSN
- 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),"^")
- ;IHS/CIA/MGH Get variable for HRCN
- S GMRCHRCN=$$HRCN^GMRCMP(DFN,+$G(DUZ(2)))
- 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
- GMRCPOR ;SLC/DCM,DLT - Get DOC,LOC,TS in interactive defaults ;15-Mar-2012 10:40;PLS
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,1001,1003**;DEC 27, 1997;Build 14
- +2 ;Modified - IHS/CIA/MGH - 11/29/2005 - Line DEM+5
- DEM ;Similiar to load of variables done by ORUDPA
- +1 ;;Call from ^GMRCR0
- +2 ;IHS/CIA/MGH Added code to use HRCN instead of SSN
- +3 SET ORVP=DFN_";DPT("
- SET VA200=1
- +4 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),"^")
- +5 ;IHS/CIA/MGH Get variable for HRCN
- +6 SET GMRCHRCN=$$HRCN^GMRCMP(DFN,+$GET(DUZ(2)))
- +7 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))=""
- +8 IF ORNP
- IF '$DATA(^VA(200,ORNP,0))
- SET ORNP=""
- +9 SET ORPV=""
- IF ORNP
- IF $DATA(^XUSEC("PROVIDER",ORNP))
- SET ORPV=ORNP
- +10 SET ORATTEND=ORNP
- +11 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
- +12 DO DOC
- DO LOC
- DO DOC1
- +13 KILL O,ORL(0),DIC,VA,VAIN,VADM,VAERR,Y
- +14 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
