APCD3MT.m

APCD3MT ; IHS/CMI/LAB - PCC TO 3M CODER TEST ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;;2.0

 ;

 ; This routine asks the user for a visit and tests the PCC

 ; to 3M Interface using the specified visit for patient data.

 ;

 ;

START ;

 D PROCESS

 D EOJ

 Q

 ;

PROCESS ;

 D INIT

 Q:APCD3Q

 D CALL3M

 Q

 ;

INIT ; INITIALIZATION

 S APCD3Q=1

 D GETPAT ;                               get patient

 Q:'APCDPAT

 D GETVISIT ;                             get visit

 Q:'APCDVSIT

 S APCD3Q=0

 Q

 ;

GETPAT ; GET PATIENT FOR TEST DATA

 S APCDPAT=0

 S DIC="^AUPNPAT(",DIC(0)="AEMQ"

 D ^DIC

 Q:Y<0

 S APCDPAT=+Y

 Q

 ;

GETVISIT ; GET VISIT FOR TEST DATA

 NEW APCD3V,X,Y

 S APCDVSIT=0

 S APCD3V=""

 F  Q:$D(DIRUT)  S APCD3V=$O(^AUPNVSIT("AC",APCDPAT,APCD3V),-1) Q:'APCD3V  D  Q:APCDVSIT

 .  S X=$G(^AUPNVSIT(APCD3V,0))

 .  Q:X=""

 .  W !!,APCD3V,"  ",$P(X,U)_"  "_$P(X,U,9)

 .  D ASK

 .  Q:Y'=1

 .  S APCDVSIT=APCD3V

 .  Q

 Q:'APCDVSIT

 S APCDDATE=+^AUPNVSIT(APCDVSIT,0),APCDTYPE=$P(^AUPNVSIT(APCDVSIT,0),U,3),APCDCAT=$P(^(0),U,7),APCDLOC=$P(^(0),U,6),APCDCLN=$P(^(0),U,8)

 Q

 ;

ASK ; ASK USER YES OR NO

 NEW X

 S DIR(0)="YO",DIR("A")="Do you want this visit (Y/N)",DIR("B")="NO" KILL DA D ^DIR KILL DIR

 Q

 ;

CALL3M ; CALL 3M INTERFACE WITH VISIT DATA

 D EN^APCD3ME

 S X=$G(APCD3MIP)

 D EN^XBVK("APCD")

 S APCD3MIP=$G(X)

 Q

 ;

EOJ ;

 K APCD3Q

 D ^XBFMK

 D EN^XBVK("%")

 D EN^XBVK("APCD")

 Q

 ;

APCD3MT   ; IHS/CMI/LAB - PCC TO 3M CODER TEST ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;;2.0

 +3       ;

 +4       ; This routine asks the user for a visit and tests the PCC

 +5       ; to 3M Interface using the specified visit for patient data.

 +6       ;

 +7       ;

START     ;

 +1        DO PROCESS

 +2        DO EOJ

 +3        QUIT 

 +4       ;

PROCESS   ;

 +1        DO INIT

 +2        IF APCD3Q

               QUIT 

 +3        DO CALL3M

 +4        QUIT 

 +5       ;

INIT      ; INITIALIZATION

 +1        SET APCD3Q=1

 +2       ;                               get patient

           DO GETPAT

 +3        IF 'APCDPAT

               QUIT 

 +4       ;                             get visit

           DO GETVISIT

 +5        IF 'APCDVSIT

               QUIT 

 +6        SET APCD3Q=0

 +7        QUIT 

 +8       ;

GETPAT    ; GET PATIENT FOR TEST DATA

 +1        SET APCDPAT=0

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

 +3        DO ^DIC

 +4        IF Y<0

               QUIT 

 +5        SET APCDPAT=+Y

 +6        QUIT 

 +7       ;

GETVISIT  ; GET VISIT FOR TEST DATA

 +1        NEW APCD3V,X,Y

 +2        SET APCDVSIT=0

 +3        SET APCD3V=""

 +4        FOR 

               IF $DATA(DIRUT)

                   QUIT 

               SET APCD3V=$ORDER(^AUPNVSIT("AC",APCDPAT,APCD3V),-1)

               IF 'APCD3V

                   QUIT 

               Begin DoDot:1

 +5                SET X=$GET(^AUPNVSIT(APCD3V,0))

 +6                IF X=""

                       QUIT 

 +7                WRITE !!,APCD3V,"  ",$PIECE(X,U)_"  "_$PIECE(X,U,9)

 +8                DO ASK

 +9                IF Y'=1

                       QUIT 

 +10               SET APCDVSIT=APCD3V

 +11               QUIT 

               End DoDot:1

               IF APCDVSIT

                   QUIT 

 +12       IF 'APCDVSIT

               QUIT 

 +13       SET APCDDATE=+^AUPNVSIT(APCDVSIT,0)

           SET APCDTYPE=$PIECE(^AUPNVSIT(APCDVSIT,0),U,3)

           SET APCDCAT=$PIECE(^(0),U,7)

           SET APCDLOC=$PIECE(^(0),U,6)

           SET APCDCLN=$PIECE(^(0),U,8)

 +14       QUIT 

 +15      ;

ASK       ; ASK USER YES OR NO

 +1        NEW X

 +2        SET DIR(0)="YO"

           SET DIR("A")="Do you want this visit (Y/N)"

           SET DIR("B")="NO"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        QUIT 

 +4       ;

CALL3M    ; CALL 3M INTERFACE WITH VISIT DATA

 +1        DO EN^APCD3ME

 +2        SET X=$GET(APCD3MIP)

 +3        DO EN^XBVK("APCD")

 +4        SET APCD3MIP=$GET(X)

 +5        QUIT 

 +6       ;

EOJ       ;

 +1        KILL APCD3Q

 +2        DO ^XBFMK

 +3        DO EN^XBVK("%")

 +4        DO EN^XBVK("APCD")

 +5        QUIT 

 +6       ;