BPMHRCN.m

BPMHRCN ; IHS/TUCSON/JCM - DISPLAYS CHART NUMBERS FROM PATIENT FILE ;

 ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 ;IHS/OIT/LJF 11/02/2006 changed namespace from DPTD to BPM

START ;

 D CHARTS

 D EOJ

 Q

 ;

CHARTS ; Displays chart numbers and facilities for patients

 W !!,"*** HEALTH RECORD NO."

 S Y=XDRMCD,Y(2)=XDRMCD2

 S BPMLKF=0,BPMLKFF=0,BPMLKI=0

 I $D(^AUPNPAT(Y,41,0)) F BPMLKI=0:1 S BPMLKF=$O(^AUPNPAT(Y,41,BPMLKF)) Q:'BPMLKF  W:BPMLKI ! W ?23," ",$J($P(^AUTTLOC(BPMLKF,0),U,7),4)," ",$P(^AUPNPAT(Y,41,BPMLKF,0),U,2) I $D(^AUPNPAT(Y(2),41,0)) D CHART2

 I $D(^AUPNPAT(Y(2),41,0)),$P(^AUPNPAT(Y(2),41,0),U,4)>BPMLKI F BPMLKII=1:1 Q:'$O(^AUPNPAT(Y(2),41,BPMLKFF))  W ! D CHART2

 Q

CHART2 ;prints second patient's chart numbers

 I '$D(BPMLKII),$P(^AUPNPAT(Y(2),41,0),U,4)<(BPMLKI+1) G CHART2X

 S BPMLKFF=$O(^AUPNPAT(Y(2),41,BPMLKFF))

 W ?49 W " ",$J($P(^AUTTLOC(BPMLKFF,0),U,7),4)," ",$P(^AUPNPAT(Y(2),41,BPMLKFF,0),U,2)

 ;

CHART2X ;

 Q

 ;

EOJ ;

 K BPM,Y,BPMLKF,BPMLKFF,BPMLKI,BPMLKII

 Q

BPMHRCN   ; IHS/TUCSON/JCM - DISPLAYS CHART NUMBERS FROM PATIENT FILE ;

 +1       ;;1.0;IHS PATIENT MERGE;;MAR 01, 2010

 +2       ;IHS/OIT/LJF 11/02/2006 changed namespace from DPTD to BPM

START     ;

 +1        DO CHARTS

 +2        DO EOJ

 +3        QUIT 

 +4       ;

CHARTS    ; Displays chart numbers and facilities for patients

 +1        WRITE !!,"*** HEALTH RECORD NO."

 +2        SET Y=XDRMCD

           SET Y(2)=XDRMCD2

 +3        SET BPMLKF=0

           SET BPMLKFF=0

           SET BPMLKI=0

 +4        IF $DATA(^AUPNPAT(Y,41,0))

               FOR BPMLKI=0:1

                   SET BPMLKF=$ORDER(^AUPNPAT(Y,41,BPMLKF))

                   IF 'BPMLKF

                       QUIT 

                   IF BPMLKI

                       WRITE !

                   WRITE ?23," ",$JUSTIFY($PIECE(^AUTTLOC(BPMLKF,0),U,7),4)," ",$PIECE(^AUPNPAT(Y,41,BPMLKF,0),U,2)

                   IF $DATA(^AUPNPAT(Y(2),41,0))

                       DO CHART2

 +5        IF $DATA(^AUPNPAT(Y(2),41,0))

               IF $PIECE(^AUPNPAT(Y(2),41,0),U,4)>BPMLKI

                   FOR BPMLKII=1:1

                       IF '$ORDER(^AUPNPAT(Y(2),41,BPMLKFF))

                           QUIT 

                       WRITE !

                       DO CHART2

 +6        QUIT 

CHART2    ;prints second patient's chart numbers

 +1        IF '$DATA(BPMLKII)

               IF $PIECE(^AUPNPAT(Y(2),41,0),U,4)<(BPMLKI+1)

                   GOTO CHART2X

 +2        SET BPMLKFF=$ORDER(^AUPNPAT(Y(2),41,BPMLKFF))

 +3        WRITE ?49

           WRITE " ",$JUSTIFY($PIECE(^AUTTLOC(BPMLKFF,0),U,7),4)," ",$PIECE(^AUPNPAT(Y(2),41,BPMLKFF,0),U,2)

 +4       ;

CHART2X   ;

 +1        QUIT 

 +2       ;

EOJ       ;

 +1        KILL BPM,Y,BPMLKF,BPMLKFF,BPMLKI,BPMLKII

 +2        QUIT