ADGPCAC5.m

ADGPCAC5 ; IHS/ADC/PDW/ENM - ADT/PCC DATA ENTRY-IMMUNIZATION ; [ 03/25/1999  11:48 AM ]

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

 ;

A ; -- driver

 D L5 Q:$D(DIRUT)

 D ^ADGPCAC6 Q

 ;

L5 ; -- loop v immunization

 N IFN,N

 Q:'$D(^AUPNVIMM("AD",DGVI))

 W @IOF," (5) Immunization"

 S IFN=0 F  S IFN=$O(^AUPNVIMM("AD",DGVI,IFN)) Q:'IFN  D 5 Q:$D(DIRUT)

 Q:$D(DIRUT)  D Q Q

 ;

5 ; -- display immunization info

 Q:'$D(^AUPNVIMM(IFN,0))  S N=^(0)

 W !!?9,"Immunization: ",$$IMM,!?15,"Series: ",$$SER

 W:$P(N,U,4)'="" ?43,"Max # in Series: ",$$MAX

 W !?18,"Lot: ",$P(N,U,5)

 ; -- form feed?

 W ! Q:($Y+4)'>IOSL  S DIR(0)="E" D ^DIR K DIR,X W @IOF Q

 ;

Q ; -- cleanup

 K DIR W ! S DIR(0)="E" D ^DIR K DIR,X W @IOF Q

 ;

IMM() ; -- immunization

 Q $P($G(^AUTTIMM(+N,0)),U)_"  "_$E($P($G(^AUTTIMM(+N,0)),U,3),1,3)

 ;

SER() ; -- series

 N Y S Y=$P(N,U,4) S C=$P(^DD(9000010.11,.04,0),U,2) D Y^DIQ Q Y

 ;

MAX() ; -- max # in series

 Q $P($G(^AUTTIMM(+N,0)),U,5)

ADGPCAC5  ; IHS/ADC/PDW/ENM - ADT/PCC DATA ENTRY-IMMUNIZATION ; [ 03/25/1999  11:48 AM ]

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

 +2       ;

A         ; -- driver

 +1        DO L5

           IF $DATA(DIRUT)

               QUIT 

 +2        DO ^ADGPCAC6

           QUIT 

 +3       ;

L5        ; -- loop v immunization

 +1        NEW IFN,N

 +2        IF '$DATA(^AUPNVIMM("AD",DGVI))

               QUIT 

 +3        WRITE @IOF," (5) Immunization"

 +4        SET IFN=0

           FOR 

               SET IFN=$ORDER(^AUPNVIMM("AD",DGVI,IFN))

               IF 'IFN

                   QUIT 

               DO 5

               IF $DATA(DIRUT)

                   QUIT 

 +5        IF $DATA(DIRUT)

               QUIT 

           DO Q

           QUIT 

 +6       ;

5         ; -- display immunization info

 +1        IF '$DATA(^AUPNVIMM(IFN,0))

               QUIT 

           SET N=^(0)

 +2        WRITE !!?9,"Immunization: ",$$IMM,!?15,"Series: ",$$SER

 +3        IF $PIECE(N,U,4)'=""

               WRITE ?43,"Max # in Series: ",$$MAX

 +4        WRITE !?18,"Lot: ",$PIECE(N,U,5)

 +5       ; -- form feed?

 +6        WRITE !

           IF ($Y+4)'>IOSL

               QUIT 

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR,X

           WRITE @IOF

           QUIT 

 +7       ;

Q         ; -- cleanup

 +1        KILL DIR

           WRITE !

           SET DIR(0)="E"

           DO ^DIR

           KILL DIR,X

           WRITE @IOF

           QUIT 

 +2       ;

IMM()     ; -- immunization

 +1        QUIT $PIECE($GET(^AUTTIMM(+N,0)),U)_"  "_$EXTRACT($PIECE($GET(^AUTTIMM(+N,0)),U,3),1,3)

 +2       ;

SER()     ; -- series

 +1        NEW Y

           SET Y=$PIECE(N,U,4)

           SET C=$PIECE(^DD(9000010.11,.04,0),U,2)

           DO Y^DIQ

           QUIT Y

 +2       ;

MAX()     ; -- max # in series

 +1        QUIT $PIECE($GET(^AUTTIMM(+N,0)),U,5)