APCDAAC1.m

APCDAAC1 ; IHS/CMI/LAB - CDMIS PCC LINK ;

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

 ;FILE 200 CONV

 ;

 ;

 ;

VFILES ;EP Create v file entries

 D PROV

 I $G(APCDQUIT) D VFERROR

 D POV

 D AT

 I $D(APCDQUIT) D VFERROR

 D EOJ

 Q

 ;

PROV ; v provider

 ; ***************** MULTIPLE PROVIDERS *******************

 S APCDFILE="V PROVIDER"

 D KILL

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"

 S APCDALVR("APCDPAT")=ACDEV("PAT")

 S APCDALVR("APCDTPS")="P"

 S X=ACDEV("PRI PROV") I $P(^DD(9000010.06,.01,0),U,2)[6 S P=ACDEV("PRI PROV"),A=$P(^DIC(3,P,0),U,16) D  K A,P

 .I A="" S APCDQUIT=42,X="" Q

 .I $P(^VA(200,P,0),U)'=$P(^DIC(16,A,0),U) S APCDQUIT=42,X="" Q

 .S X=A

 .Q

 I X="" S APCDQUIT=41 Q

 I X]"" S APCDALVR("APCDTPRO")="`"_X

 D APCDALVR

 Q

 ;

POV ;create V POVS

 S APCDFILE="V POV"

 S (APCDY,APCDGOT)=0

 F  S APCDY=$O(ACDEV("POV",APCDY)) Q:'APCDY  D

 .D KILL

 .S APCDALVR("APCDTPOV")=+ACDEV("POV",APCDY) I APCDALVR("APCDTPOV")="" S APCDQUIT=43 D VFERROR Q

 .S APCDALVR("APCDVSIT")=APCDVSIT

 .S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"

 .S APCDALVR("APCDPAT")=ACDEV("PAT")

 .S APCDALVR("APCDOVRR")=""

 .;************* WHAT IS APCDTNQ ***************

 .S APCDALVR("APCDTNQ")="`"_$P(ACDEV("POV",APCDY),U,6)

 .D APCDALVR

 .Q

 Q

 ;

AT ;create v activity time record

 Q:'$G(ACDEV("TIME"))  ;          quit if no time

 S APCDFILE="V ACTIVITY TIME"

 D KILL

 S APCDALVR("APCDTACT")=ACDEV("TIME")

 S APCDALVR("APCDVSIT")=APCDVSIT

 S APCDALVR("APCDATMP")="[APCDALVR 9000010.19 (ADD)]"

 S APCDALVR("APCDPAT")=ACDEV("PAT")

 S APCDALVR("APCDTTM")="**************************"

 D APCDALVR

 Q

 ;

APCDALVR ;D APCDALVR

 D ^APCDALVR

 I $D(APCDALVR("APCDAFLG")) S APCDQUIT=APCDALVR("APCDAFLG") D VFERROR Q

 S APCDV("VFILES",APCDALVR("APCDAVF"),APCDALVR("APCDADFN"))=""

 Q

 ;

KILL ;

 K APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT

 Q

 ;

EOJ ;

 D KILL

 K APCDDATK,APCDPAT,APCDX,APCDACTL,APCDLOC

 Q

 ;

VFERROR ;EP

 S APCDIEN=ACDEV("VISIT")

 S APCDERR="VE"_APCDQUIT,APCDERR=$P($T(@APCDERR),";;",2)

 D LBULL^APCDALD

 K APCDQUIT,APCDERR

 Q

 ;

VE1 ;;incorrect template specification

VE2 ;;invalid values being passed to V file.

VE3 ;;invalid visit parameters (date, location etc.)

VE41 ;;No PROVIDER ENTRY PASSED from CDMIS SYSTEM.

VE42 ;;Could NOT convert 200 Pointer to 6 pointer.

VE43 ;;Could not find ICD9 code in ICD Diagnosis file.

APCDAAC1  ; IHS/CMI/LAB - CDMIS PCC LINK ;

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

 +2       ;FILE 200 CONV

 +3       ;

 +4       ;

 +5       ;

VFILES    ;EP Create v file entries

 +1        DO PROV

 +2        IF $GET(APCDQUIT)

               DO VFERROR

 +3        DO POV

 +4        DO AT

 +5        IF $DATA(APCDQUIT)

               DO VFERROR

 +6        DO EOJ

 +7        QUIT 

 +8       ;

PROV      ; v provider

 +1       ; ***************** MULTIPLE PROVIDERS *******************

 +2        SET APCDFILE="V PROVIDER"

 +3        DO KILL

 +4        SET APCDALVR("APCDVSIT")=APCDVSIT

 +5        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"

 +6        SET APCDALVR("APCDPAT")=ACDEV("PAT")

 +7        SET APCDALVR("APCDTPS")="P"

 +8        SET X=ACDEV("PRI PROV")

           IF $PIECE(^DD(9000010.06,.01,0),U,2)[6

               SET P=ACDEV("PRI PROV")

               SET A=$PIECE(^DIC(3,P,0),U,16)

               Begin DoDot:1

 +9                IF A=""

                       SET APCDQUIT=42

                       SET X=""

                       QUIT 

 +10               IF $PIECE(^VA(200,P,0),U)'=$PIECE(^DIC(16,A,0),U)

                       SET APCDQUIT=42

                       SET X=""

                       QUIT 

 +11               SET X=A

 +12               QUIT 

               End DoDot:1

               KILL A,P

 +13       IF X=""

               SET APCDQUIT=41

               QUIT 

 +14       IF X]""

               SET APCDALVR("APCDTPRO")="`"_X

 +15       DO APCDALVR

 +16       QUIT 

 +17      ;

POV       ;create V POVS

 +1        SET APCDFILE="V POV"

 +2        SET (APCDY,APCDGOT)=0

 +3        FOR 

               SET APCDY=$ORDER(ACDEV("POV",APCDY))

               IF 'APCDY

                   QUIT 

               Begin DoDot:1

 +4                DO KILL

 +5                SET APCDALVR("APCDTPOV")=+ACDEV("POV",APCDY)

                   IF APCDALVR("APCDTPOV")=""

                       SET APCDQUIT=43

                       DO VFERROR

                       QUIT 

 +6                SET APCDALVR("APCDVSIT")=APCDVSIT

 +7                SET APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"

 +8                SET APCDALVR("APCDPAT")=ACDEV("PAT")

 +9                SET APCDALVR("APCDOVRR")=""

 +10      ;************* WHAT IS APCDTNQ ***************

 +11               SET APCDALVR("APCDTNQ")="`"_$PIECE(ACDEV("POV",APCDY),U,6)

 +12               DO APCDALVR

 +13               QUIT 

               End DoDot:1

 +14       QUIT 

 +15      ;

AT        ;create v activity time record

 +1       ;          quit if no time

           IF '$GET(ACDEV("TIME"))

               QUIT 

 +2        SET APCDFILE="V ACTIVITY TIME"

 +3        DO KILL

 +4        SET APCDALVR("APCDTACT")=ACDEV("TIME")

 +5        SET APCDALVR("APCDVSIT")=APCDVSIT

 +6        SET APCDALVR("APCDATMP")="[APCDALVR 9000010.19 (ADD)]"

 +7        SET APCDALVR("APCDPAT")=ACDEV("PAT")

 +8        SET APCDALVR("APCDTTM")="**************************"

 +9        DO APCDALVR

 +10       QUIT 

 +11      ;

APCDALVR  ;D APCDALVR

 +1        DO ^APCDALVR

 +2        IF $DATA(APCDALVR("APCDAFLG"))

               SET APCDQUIT=APCDALVR("APCDAFLG")

               DO VFERROR

               QUIT 

 +3        SET APCDV("VFILES",APCDALVR("APCDAVF"),APCDALVR("APCDADFN"))=""

 +4        QUIT 

 +5       ;

KILL      ;

 +1        KILL APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT

 +2        QUIT 

 +3       ;

EOJ       ;

 +1        DO KILL

 +2        KILL APCDDATK,APCDPAT,APCDX,APCDACTL,APCDLOC

 +3        QUIT 

 +4       ;

VFERROR   ;EP

 +1        SET APCDIEN=ACDEV("VISIT")

 +2        SET APCDERR="VE"_APCDQUIT

           SET APCDERR=$PIECE($TEXT(@APCDERR),";;",2)

 +3        DO LBULL^APCDALD

 +4        KILL APCDQUIT,APCDERR

 +5        QUIT 

 +6       ;

VE1       ;;incorrect template specification

VE2       ;;invalid values being passed to V file.

VE3       ;;invalid visit parameters (date, location etc.)

VE41      ;;No PROVIDER ENTRY PASSED from CDMIS SYSTEM.

VE42      ;;Could NOT convert 200 Pointer to 6 pointer.

VE43      ;;Could not find ICD9 code in ICD Diagnosis file.