| 1 | GMVUTL3 ;HOIFO/YH,FT-RPCBROKER UTILITY ROUTINE TO EXTRACT NURSING UNIT/ROOM-BED - 3 ;10/24/03 14:20
|
|---|
| 2 | ;;5.0;GEN. MED. REC. - VITALS;**3**;Oct 31, 2002
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ; #2692 - ^ORQPTQ1 calls (controlled)
|
|---|
| 6 | ; #10061 - ^VADPT calls (supported)
|
|---|
| 7 | ; #10099 - ^GMRADPT calls (supported)
|
|---|
| 8 | ;
|
|---|
| 9 | ; This routine supports the following IAs:
|
|---|
| 10 | ; #4350 - GMV ALLERGY RPC called at ALLERGY (private)
|
|---|
| 11 | ;
|
|---|
| 12 | PTINFO(RESULT,DFN,GMVDT) ; gets patient demographic and eligibility info
|
|---|
| 13 | ;RESULT=SSN^DOB^SEX AND AGE^ATTENDING^VETERAN^INTERNAL DATE/TIME
|
|---|
| 14 | ; DECEASED^EXTERNAL DATE/TIME DECEASED
|
|---|
| 15 | D 1^VADPT,ELIG^VADPT
|
|---|
| 16 | 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)
|
|---|
| 17 | S RESULT=RESULT_"^"_$S(VAEL(4)=1:"YES",1:"NO")_"^^^^"
|
|---|
| 18 | S $P(RESULT,"^",8)=$P(VAIN(4),"^",2),$P(RESULT,"^",9)=$P(VAIN(5),"^")
|
|---|
| 19 | I VADM(6)>0 S $P(RESULT,"^",6)=$P(VADM(6),"^"),$P(RESULT,"^",7)=$P(VADM(6),"^",2)
|
|---|
| 20 | S $P(RESULT,"^",10)=VADM(1)
|
|---|
| 21 | N GMVSENS
|
|---|
| 22 | S GMVSENS=$$PTREC^GMVRPCP(DFN) ;check sensitvity of DOB and SSN
|
|---|
| 23 | S $P(RESULT,U,1)=$P(GMVSENS,U,11) ;SSN
|
|---|
| 24 | S $P(RESULT,U,2)=$P(GMVSENS,U,10) ;DOB
|
|---|
| 25 | Q
|
|---|
| 26 | TEAMPT(RESULT,GMVTEAM) ;GMV TEAM PATIENTS [RPC entry point]
|
|---|
| 27 | ; Calls CPRS API (IA #2692) and return list of patients for a given
|
|---|
| 28 | ; team (File 100.21, Field 10).
|
|---|
| 29 | N GMVI,GMVOUT,GMVPTNUM
|
|---|
| 30 | ; Call CPRS API with name of array to return data in and the IEN of
|
|---|
| 31 | ; the File 100.21 entry. CPRS returns:
|
|---|
| 32 | ; Arrayname(Sequential #)=DFN ^ patient name (File 2, Field .01)
|
|---|
| 33 | D TEAMPTS^ORQPTQ1(.GMVOUT,GMVTEAM)
|
|---|
| 34 | I $P($G(GMVOUT(1)),U,1)="" S RESULT(1)="NO PATIENTS" Q
|
|---|
| 35 | S GMVI=0
|
|---|
| 36 | F S GMVI=$O(GMVOUT(GMVI)) Q:'GMVI D
|
|---|
| 37 | .S GMVPTNUM=+$P(GMVOUT(GMVI),U,1)
|
|---|
| 38 | .D PTINFO(.GMVPAT,GMVPTNUM)
|
|---|
| 39 | .S RESULT(GMVI)=$P(GMVOUT(GMVI),U,2)_U_+$P(GMVOUT(GMVI),U,1)_U_GMVPAT
|
|---|
| 40 | .Q
|
|---|
| 41 | QUITP K OUT,ARRAY1
|
|---|
| 42 | Q
|
|---|
| 43 | ALLERGY(RESULT,DFN) ;GMV ALLERGY [RPC entry point]
|
|---|
| 44 | N GMRAL,GMVALG,GN D EN1^GMRADPT M GMVALG=GMRAL
|
|---|
| 45 | I $O(GMVALG(0))'>0 D Q
|
|---|
| 46 | . I $G(GMVALG)="" S RESULT(1)="No Allergy Assessment"
|
|---|
| 47 | . I $G(GMVALG)=0 S RESULT(1)="No Known Allergies"
|
|---|
| 48 | . Q
|
|---|
| 49 | 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
|
|---|
| 50 | . S GN=GN+1,RESULT(GN)=$P($G(GMVALG(GN(1))),U,2)
|
|---|
| 51 | Q
|
|---|
