ADGINPL.m

ADGINPL ; IHS/ADC/PDW/ENM - PROVIDER-INPATIENT INQUIRY ; [ 03/25/1999  11:48 AM ]

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

 ;

 N DGPRDA,DGPVN,DFN,X,Y

A ; -- driver

 D ^XBCLS W !!?20,"INPATIENT PROVIDER INQUIRY",!!

 D SP Q:Y'>0

 D LP G A

 ;

SP ; -- select provider

 S DIC=200,DIC(0)="AEQMZ",DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"

 S DIC("A")="Select PROVIDER:  " D ^DIC K DIC

 S DGPRDA=+Y,DGPVN=$P(Y,U,2) Q

 ;

LP ; -- loop APR (provider) x-ref of va patient file

 I '$D(^DPT("APR",DGPRDA)) D  Q

 . W !!,"  No inpatients currently assigned to this provider",!

 D HD S DFN=0 F  S DFN=$O(^DPT("APR",DGPRDA,DFN)) Q:'DFN  D

 . Q:'$D(^DPT(DFN,.104))  D LN

 W ! D PRTOPT^ADGVAR Q

 ;

LN ; -- patient information

 W !,$P(^DPT(DFN,0),U),?32,$$HRCN^ADGF,?45,$G(^DPT(DFN,.1))

 W ?53,$G(^DPT(DFN,.101))

 I $D(^DPT(DFN,.103)) W ?63,$P(^DIC(45.7,+^(.103),0),U)

 Q

 ;

HD ; -- heading

 W @IOF W !!,"CURRENT INPATIENTS FOR ",DGPVN,":",!

 W !,"PATIENT NAME",?32,"CHART #",?45,"WARD",?53,"RM-BD",?63,"SERVICE"

 W !,"------------",?32,"-------",?45,"----",?53,"-----",?63,"-------"

 Q

ADGINPL   ; IHS/ADC/PDW/ENM - PROVIDER-INPATIENT INQUIRY ; [ 03/25/1999  11:48 AM ]

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

 +2       ;

 +3        NEW DGPRDA,DGPVN,DFN,X,Y

A         ; -- driver

 +1        DO ^XBCLS

           WRITE !!?20,"INPATIENT PROVIDER INQUIRY",!!

 +2        DO SP

           IF Y'>0

               QUIT 

 +3        DO LP

           GOTO A

 +4       ;

SP        ; -- select provider

 +1        SET DIC=200

           SET DIC(0)="AEQMZ"

           SET DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"

 +2        SET DIC("A")="Select PROVIDER:  "

           DO ^DIC

           KILL DIC

 +3        SET DGPRDA=+Y

           SET DGPVN=$PIECE(Y,U,2)

           QUIT 

 +4       ;

LP        ; -- loop APR (provider) x-ref of va patient file

 +1        IF '$DATA(^DPT("APR",DGPRDA))

               Begin DoDot:1

 +2                WRITE !!,"  No inpatients currently assigned to this provider",!

               End DoDot:1

               QUIT 

 +3        DO HD

           SET DFN=0

           FOR 

               SET DFN=$ORDER(^DPT("APR",DGPRDA,DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +4                IF '$DATA(^DPT(DFN,.104))

                       QUIT 

                   DO LN

               End DoDot:1

 +5        WRITE !

           DO PRTOPT^ADGVAR

           QUIT 

 +6       ;

LN        ; -- patient information

 +1        WRITE !,$PIECE(^DPT(DFN,0),U),?32,$$HRCN^ADGF,?45,$GET(^DPT(DFN,.1))

 +2        WRITE ?53,$GET(^DPT(DFN,.101))

 +3        IF $DATA(^DPT(DFN,.103))

               WRITE ?63,$PIECE(^DIC(45.7,+^(.103),0),U)

 +4        QUIT 

 +5       ;

HD        ; -- heading

 +1        WRITE @IOF

           WRITE !!,"CURRENT INPATIENTS FOR ",DGPVN,":",!

 +2        WRITE !,"PATIENT NAME",?32,"CHART #",?45,"WARD",?53,"RM-BD",?63,"SERVICE"

 +3        WRITE !,"------------",?32,"-------",?45,"----",?53,"-----",?63,"-------"

 +4        QUIT