ADGPEP.m

ADGPEP ; IHS/ADC/PDW/ENM - PUBLIC ENTRY POINTS ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

 ;This routine contains a series of public entry points for

 ;obtaining inpatient data on any patient

 ;

CURWARD(DFN) ;PEP; returns external format for patient's current ward

 NEW X

 S X=$$VAL^XBDIQ1(2,DFN,.1) I X]"" Q X

 S Y=9999999.9999999-$$NOW^XLFDT

 S X=$O(^DGPM("ATID3",DFN,Y)) I X="" Q ""

 Q "DSCH"

 ;

SRGWARD(DFN,SURG) ;PEP; PRIVATE ENTRY POINT returns ward at time of surgery

 ; to be called by Surgery package ONLY!!

 NEW ADG,RDT,ADMIT,ADMTX,TRNFR,TRNFX

 D ENP^XBDIQ1(130,SURG,".09;.22","ADG(","I")

 I ADG(.09)="",ADG(.22)="" Q ""

 S RDT=9999999.9999999-$S(ADG(.22)]"":ADG(.22,"I"),1:ADG(.09,"I"))

 S ADMIT=$O(^DGPM("ATID1",DFN,RDT)) I ADMIT="" Q ""

 S ADMTX=$O(^DGPM("ATID1",DFN,ADMIT,0)) I ADMTX="" Q ""

 S TRNFR=$O(^DGPM("ATID2",DFN,RDT))

 S TRNFX=$S(TRNFR="":"",1:$O(^DGPM("ATID2",DFN,TRNFR,0)))

 I TRNFX]"",$$SAMEADMT Q $$VAL^XBDIQ1(405,TRNFX,.06)

 Q $$VAL^XBDIQ1(405,ADMTX,.06)

 ;

SAMEADMT() ; -- is transfer for same admit

 Q $S($P(^DGPM(TRNFX,0),U,14)=ADMTX:1,1:0)

 ;

CURRMBD(DFN) ;PEP; returns external format for patient's current room-bed

 Q $$VAL^XBDIQ1(2,DFN,.101)

 ;

CURSRV(DFN) ;PEP; returns external format for patient's current service

 Q $$VAL^XBDIQ1(2,DFN,.103)

 ;

CURSRVI(DFN) ;PEP; returns internal format for patient's current service

 Q $$VALI^XBDIQ1(2,DFN,.103)

 ;

CURPRV(DFN) ;PEP; returns external format for patient's current att provider

 Q $$VAL^XBDIQ1(2,DFN,.104)

 ;

CURPRVI(DFN) ;PEP; returns internal format for patient's current att provider

 Q $$VALI^XBDIQ1(2,DFN,.104)

 ;

ADGPEP    ; IHS/ADC/PDW/ENM - PUBLIC ENTRY POINTS ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

 +3       ;This routine contains a series of public entry points for

 +4       ;obtaining inpatient data on any patient

 +5       ;

CURWARD(DFN) ;PEP; returns external format for patient's current ward

 +1        NEW X

 +2        SET X=$$VAL^XBDIQ1(2,DFN,.1)

           IF X]""

               QUIT X

 +3        SET Y=9999999.9999999-$$NOW^XLFDT

 +4        SET X=$ORDER(^DGPM("ATID3",DFN,Y))

           IF X=""

               QUIT ""

 +5        QUIT "DSCH"

 +6       ;

SRGWARD(DFN,SURG) ;PEP; PRIVATE ENTRY POINT returns ward at time of surgery

 +1       ; to be called by Surgery package ONLY!!

 +2        NEW ADG,RDT,ADMIT,ADMTX,TRNFR,TRNFX

 +3        DO ENP^XBDIQ1(130,SURG,".09;.22","ADG(","I")

 +4        IF ADG(.09)=""

               IF ADG(.22)=""

                   QUIT ""

 +5        SET RDT=9999999.9999999-$SELECT(ADG(.22)]"":ADG(.22,"I"),1:ADG(.09,"I"))

 +6        SET ADMIT=$ORDER(^DGPM("ATID1",DFN,RDT))

           IF ADMIT=""

               QUIT ""

 +7        SET ADMTX=$ORDER(^DGPM("ATID1",DFN,ADMIT,0))

           IF ADMTX=""

               QUIT ""

 +8        SET TRNFR=$ORDER(^DGPM("ATID2",DFN,RDT))

 +9        SET TRNFX=$SELECT(TRNFR="":"",1:$ORDER(^DGPM("ATID2",DFN,TRNFR,0)))

 +10       IF TRNFX]""

               IF $$SAMEADMT

                   QUIT $$VAL^XBDIQ1(405,TRNFX,.06)

 +11       QUIT $$VAL^XBDIQ1(405,ADMTX,.06)

 +12      ;

SAMEADMT() ; -- is transfer for same admit

 +1        QUIT $SELECT($PIECE(^DGPM(TRNFX,0),U,14)=ADMTX:1,1:0)

 +2       ;

CURRMBD(DFN) ;PEP; returns external format for patient's current room-bed

 +1        QUIT $$VAL^XBDIQ1(2,DFN,.101)

 +2       ;

CURSRV(DFN) ;PEP; returns external format for patient's current service

 +1        QUIT $$VAL^XBDIQ1(2,DFN,.103)

 +2       ;

CURSRVI(DFN) ;PEP; returns internal format for patient's current service

 +1        QUIT $$VALI^XBDIQ1(2,DFN,.103)

 +2       ;

CURPRV(DFN) ;PEP; returns external format for patient's current att provider

 +1        QUIT $$VAL^XBDIQ1(2,DFN,.104)

 +2       ;

CURPRVI(DFN) ;PEP; returns internal format for patient's current att provider

 +1        QUIT $$VALI^XBDIQ1(2,DFN,.104)

 +2       ;