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
Q
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
Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMVUTL3 2313 printed Nov 22, 2024@17:10:13 Page 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
