GMRCPOR.m

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