Routine: GMVUTL3

GMVUTL3 ;HOIFO/YH,FT-RPCBROKER UTILITY ROUTINE TO EXTRACT NURSING UNIT/ROOM-BED - 3 ;10/24/03  14:20

 ;;5.0;GEN. MED. REC. - VITALS;**3**;Oct 31, 2002

 ; This routine uses the following IAs:

 ;  #2692 - ^ORQPTQ1 calls         (controlled)

 ; #10061 - ^VADPT calls           (supported)

 ; #10099 - ^GMRADPT calls         (supported)

 ; This routine supports the following IAs:

 ; #4350  - GMV ALLERGY RPC called at ALLERGY  (private)

PTINFO(RESULT,DFN,GMVDT) ; gets patient demographic and eligibility info

 ;RESULT=SSN^DOB^SEX AND AGE^ATTENDING^VETERAN^INTERNAL DATE/TIME

 ;       DECEASED^EXTERNAL DATE/TIME DECEASED

 D 1^VADPT,ELIG^VADPT

 S RESULT=$P($G(VADM(2)),"^",2)_"^"_$P($G(VADM(3)),"^",2)_"^"_$P($G(VADM(5)),"^",2)_", "_$P($G(VADM(4)),"^")_" years"_"^"_$P($G(VAIN(11)),"^",2)

 S RESULT=RESULT_"^"_$S(VAEL(4)=1:"YES",1:"NO")_"^^^^"

 S $P(RESULT,"^",8)=$P(VAIN(4),"^",2),$P(RESULT,"^",9)=$P(VAIN(5),"^")

 I VADM(6)>0 S $P(RESULT,"^",6)=$P(VADM(6),"^"),$P(RESULT,"^",7)=$P(VADM(6),"^",2)

 S $P(RESULT,"^",10)=VADM(1)

 N GMVSENS

 S GMVSENS=$$PTREC^GMVRPCP(DFN) ;check sensitvity of DOB and SSN

 S $P(RESULT,U,1)=$P(GMVSENS,U,11) ;SSN

 S $P(RESULT,U,2)=$P(GMVSENS,U,10) ;DOB

TEAMPT(RESULT,GMVTEAM) ;GMV TEAM PATIENTS [RPC entry point]

 ; Calls CPRS API (IA #2692) and return list of patients for a given

 ; team (File 100.21, Field 10).

 N GMVI,GMVOUT,GMVPTNUM

 ; Call CPRS API with name of array to return data in and the IEN of

 ; the File 100.21 entry. CPRS returns:

 ; Arrayname(Sequential #)=DFN ^ patient name (File 2, Field .01)

 D TEAMPTS^ORQPTQ1(.GMVOUT,GMVTEAM)

 I $P($G(GMVOUT(1)),U,1)="" S RESULT(1)="NO PATIENTS" Q

 S GMVI=0

 F  S GMVI=$O(GMVOUT(GMVI)) Q:'GMVI  D

 .S GMVPTNUM=+$P(GMVOUT(GMVI),U,1)

 .D PTINFO(.GMVPAT,GMVPTNUM)

 .S RESULT(GMVI)=$P(GMVOUT(GMVI),U,2)_U_+$P(GMVOUT(GMVI),U,1)_U_GMVPAT

.Q

QUITP K OUT,ARRAY1

ALLERGY(RESULT,DFN) ;GMV ALLERGY [RPC entry point]

 N GMRAL,GMVALG,GN D EN1^GMRADPT M GMVALG=GMRAL

 I $O(GMVALG(0))'>0 D  Q

 . I $G(GMVALG)="" S RESULT(1)="No Allergy Assessment"

 . I $G(GMVALG)=0 S RESULT(1)="No Known Allergies"

. Q

 S GN=1,RESULT(1)="This patient has the following allergy(ies): ",GN(1)=0 F  S GN(1)=$O(GMVALG(GN(1))) Q:GN(1)'>0  D

 . S GN=GN+1,RESULT(GN)=$P($G(GMVALG(GN(1))),U,2)

GMVUTL3   ;HOIFO/YH,FT-RPCBROKER UTILITY ROUTINE TO EXTRACT NURSING UNIT/ROOM-BED - 3 ;10/24/03  14:20

 +1       ;;5.0;GEN. MED. REC. - VITALS;**3**;Oct 31, 2002

 +2       ;

 +3       ; This routine uses the following IAs:

 +4       ;  #2692 - ^ORQPTQ1 calls         (controlled)

 +5       ; #10061 - ^VADPT calls           (supported)

 +6       ; #10099 - ^GMRADPT calls         (supported)

 +7       ;

 +8       ; This routine supports the following IAs:

 +9       ; #4350  - GMV ALLERGY RPC called at ALLERGY  (private)

 +10      ;

PTINFO(RESULT,DFN,GMVDT) ; gets patient demographic and eligibility info

 +1       ;RESULT=SSN^DOB^SEX AND AGE^ATTENDING^VETERAN^INTERNAL DATE/TIME

 +2       ;       DECEASED^EXTERNAL DATE/TIME DECEASED

 +3        DO 1^VADPT

           DO ELIG^VADPT

 +4        SET RESULT=$PIECE($GET(VADM(2)),"^",2)_"^"_$PIECE($GET(VADM(3)),"^",2)_"^"_$PIECE($GET(VADM(5)),"^",2)_", "_$PIECE($GET(VADM(4)),"^")_" years"_"^"_$PIECE($GET(VAIN(11)),"^",2)

 +5        SET RESULT=RESULT_"^"_$SELECT(VAEL(4)=1:"YES",1:"NO")_"^^^^"

 +6        SET $PIECE(RESULT,"^",8)=$PIECE(VAIN(4),"^",2)

           SET $PIECE(RESULT,"^",9)=$PIECE(VAIN(5),"^")

 +7        IF VADM(6)>0

               SET $PIECE(RESULT,"^",6)=$PIECE(VADM(6),"^")

               SET $PIECE(RESULT,"^",7)=$PIECE(VADM(6),"^",2)

 +8        SET $PIECE(RESULT,"^",10)=VADM(1)

 +9        NEW GMVSENS

 +10      ;check sensitvity of DOB and SSN

           SET GMVSENS=$$PTREC^GMVRPCP(DFN)

 +11      ;SSN

           SET $PIECE(RESULT,U,1)=$PIECE(GMVSENS,U,11)

 +12      ;DOB

           SET $PIECE(RESULT,U,2)=$PIECE(GMVSENS,U,10)

 +13       QUIT

TEAMPT(RESULT,GMVTEAM) ;GMV TEAM PATIENTS [RPC entry point]

 +1       ; Calls CPRS API (IA #2692) and return list of patients for a given

 +2       ; team (File 100.21, Field 10).

 +3        NEW GMVI,GMVOUT,GMVPTNUM

 +4       ; Call CPRS API with name of array to return data in and the IEN of

 +5       ; the File 100.21 entry. CPRS returns:

 +6       ; Arrayname(Sequential #)=DFN ^ patient name (File 2, Field .01)

 +7        DO TEAMPTS^ORQPTQ1(.GMVOUT,GMVTEAM)

 +8        IF $PIECE($GET(GMVOUT(1)),U,1)=""

               SET RESULT(1)="NO PATIENTS"

               QUIT

 +9        SET GMVI=0

 +10       FOR

               SET GMVI=$ORDER(GMVOUT(GMVI))

               IF 'GMVI

                   QUIT

               Begin DoDot:1

 +11               SET GMVPTNUM=+$PIECE(GMVOUT(GMVI),U,1)

 +12               DO PTINFO(.GMVPAT,GMVPTNUM)

 +13               SET RESULT(GMVI)=$PIECE(GMVOUT(GMVI),U,2)_U_+$PIECE(GMVOUT(GMVI),U,1)_U_GMVPAT

 +14               QUIT

               End DoDot:1

QUITP      KILL OUT,ARRAY1

 +1        QUIT

ALLERGY(RESULT,DFN) ;GMV ALLERGY [RPC entry point]

 +1        NEW GMRAL,GMVALG,GN

           DO EN1^GMRADPT

           MERGE GMVALG=GMRAL

 +2        IF $ORDER(GMVALG(0))'>0

               Begin DoDot:1

 +3                IF $GET(GMVALG)=""

                       SET RESULT(1)="No Allergy Assessment"

 +4                IF $GET(GMVALG)=0

                       SET RESULT(1)="No Known Allergies"

 +5                QUIT

               End DoDot:1

               QUIT

 +6        SET GN=1

           SET RESULT(1)="This patient has the following allergy(ies): "

           SET GN(1)=0

FOR

               SET GN(1)=$ORDER(GMVALG(GN(1)))

               IF GN(1)'>0

                   QUIT

               Begin DoDot:1

 +7                SET GN=GN+1

                   SET RESULT(GN)=$PIECE($GET(GMVALG(GN(1))),U,2)

               End DoDot:1

 +8        QUIT

GMVUTL3.m