- APCD3MF ; IHS/CMI/LAB - install and generate HL7 messages to 3M ; 30 Apr 2014 8:27 AM
- ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- ;
- ;
- FILE(APCD3M) ;EP
- I '$D(APCD3M) Q ;no array passed by caller
- NEW APCDERR,APCDX,DFN,DOB,ICD9,IEN772,MSGDT,MSGTYPE,NAME,RECAPP,SENDAPP,SENDFAC,SEX,VISIT,VPOV,VPOVC
- ;new fileman and single character vars
- NEW %,%D,%E,%Y,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,I,N,X,Y,Z
- D MSGSET
- I $G(APCDERR)]"" Q
- D CHECKREC
- I $G(APCDERR)]"" D LOGERR Q
- Q
- CHECKREC ;
- S APCDX=0 F S APCDX=$O(VPOV(APCDX)) Q:APCDX'=+APCDX S Y=$P(VPOV(APCDX),"^") D
- . S Z=$G(^AUPNVPOV(Y,0)) I Z="" S APCDERR="Invalid VPOV ien passed back." Q
- . I DFN'=$P(Z,"^",2) S APCDERR="DFN in HL7 doesn't match V POV patient." Q
- . I VISIT'=$P(Z,"^",3) S APCDERR="VISIT in HL7 doesn't match V POV visit." Q
- . S N=$P(VPOV(APCDX),"^",2),%=$P(Z,"^",4),%=$P(^AUTNPOV(%,0),U) I N'=% S APCDERR="Provider Narratives mismatch" Q
- . ;file ICD code
- . S ICD9=$P(VPOV(APCDX),"^",3),ICD9=+$$CODEN^ICDEX(ICD9,80) S:+ICD9=-1 ICD9="" I ICD9="" S APCDERR="Could not find ICD code in table." Q
- . NEW DD,DO,DA,DIC,DLAYGO,I,X,Y,%,%D,%E,%Y,D0,DI,DIE,DQ,DR,AUPNSEX
- . S DA=$P(VPOV(APCDX),"^") I '$D(^AUPNVPOV(DA,0)) S APCDERR="VPOV no longer exists." Q
- . S AUPNSEX=$P(^DPT(DFN,0),"^",2)
- . S DIE="^AUPNVPOV(",DR=".01///"_ICD9 D ^DIE
- . I $D(Y) S APCDERR="Updating VPOV with code failed DIE." Q
- . Q
- Q
- MSGSET ;
- S APCDERR="",VPOVC=0
- K VPOV
- S X=0 F S X=$O(APCD3M(X)) Q:X'=+X!(APCDERR]"") S Y=$P(APCD3M(X),"|") I $T(@Y)]"" D @Y I APCDERR]"" D LOGERR
- Q
- MSH ;message segment check and set vars
- S Y=APCD3M(X)
- S SENDAPP=$P(Y,"|",3)
- S SENDFAC=$P(Y,"|",4)
- S RECAPP=$P(Y,"|",5)
- S MSGDT=$P(Y,"|",7)
- S MSGTYPE=$P(Y,"|",9)
- Q
- PID ;
- S Y=$P(APCD3M(X),"|",2,999)
- S DFN=$P(Y,"|",3)
- I DFN="" S APCDERR="No DFN passed in HL7 message" Q
- S NAME=$P(Y,"|",5)
- S DOB=$P(Y,"|",3)
- S SEX=$P(Y,"|",8)
- Q
- PV1 ;
- S Y=$P(APCD3M(X),"|",2,999)
- S VISIT=$P(Y,"|",19)
- I VISIT="" S APCDERR="No VISIT passed back in HL7 message." Q
- I '$D(^AUPNVSIT(VISIT,0)) S APCDERR="Visit has been deleted." Q
- I $P(^AUPNVSIT(VISIT,0),"^",11) S APCDERR="Visit has been deleted." Q
- Q
- DG1 ;
- S Y=$P(APCD3M(X),"|",2,999),Z=$O(APCD3M(X))
- I 'Z S APCDERR="No ZDX immediately following DG1" Q
- I $P(APCD3M(Z),"|")'="ZDX" S APCDERR="No ZDX immediately following DG1" Q
- S Z=$P(APCD3M(Z),"|",2,999)
- I $P(Y,"|",3)="" S APCDERR="No diagnosis code passed back. "_$P(Y,"|",1) Q
- I $P(Z,"|",7)="" S APCDERR="No VPOV ien passed back. "_$P(Y,"|") Q
- I $P(Z,"|")="" S APCDERR="No provider narrative passed back. "_$P(Y,"|") Q
- S VPOVC=VPOVC+1,VPOV(VPOVC)=$P(Z,"|",7)_"^"_$P(Z,"|")_"^"_$P(Y,"|",3)
- Q
- ;check for required items
- ;patient dfn, visit ien, vpov ien and icd code and narrative
- LOGERR ; Log Application Error in IHS HL7 ERROR LOG FILE (#90074)
- ;
- N DD,DO,DA,DIC,DLAYGO,I,X,Y,%,%D,%E,%Y,D0,DI,DIE,DQ,DR
- S IEN772=$S($G(APCD3M(0)):"`"_APCD3M(0),1:"")
- D NOW^%DTC S X=%
- S DIC="^BHL(90074,",DIC(0)="L",DLAYGO=90074
- S DIC("DR")=".02///^S X=RECAPP;.03///^S X=SENDAPP;.04///^S X=DUZ(2);.05///^S X=SENDFAC;.06///^S X=IEN772;.07///APCD3MF;.08///^S X=APCDERR"
- K DD,DO D FILE^DICN
- Q
- APCD3MF ; IHS/CMI/LAB - install and generate HL7 messages to 3M ; 30 Apr 2014 8:27 AM
- +1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- +2 ;
- +3 ;
- FILE(APCD3M) ;EP
- +1 ;no array passed by caller
- IF '$DATA(APCD3M)
- QUIT
- +2 NEW APCDERR,APCDX,DFN,DOB,ICD9,IEN772,MSGDT,MSGTYPE,NAME,RECAPP,SENDAPP,SENDFAC,SEX,VISIT,VPOV,VPOVC
- +3 ;new fileman and single character vars
- +4 NEW %,%D,%E,%Y,D0,DA,DD,DI,DIC,DIE,DLAYGO,DO,DQ,DR,I,N,X,Y,Z
- +5 DO MSGSET
- +6 IF $GET(APCDERR)]""
- QUIT
- +7 DO CHECKREC
- +8 IF $GET(APCDERR)]""
- DO LOGERR
- QUIT
- +9 QUIT
- CHECKREC ;
- +1 SET APCDX=0
- FOR
- SET APCDX=$ORDER(VPOV(APCDX))
- IF APCDX'=+APCDX
- QUIT
- SET Y=$PIECE(VPOV(APCDX),"^")
- Begin DoDot:1
- +2 SET Z=$GET(^AUPNVPOV(Y,0))
- IF Z=""
- SET APCDERR="Invalid VPOV ien passed back."
- QUIT
- +3 IF DFN'=$PIECE(Z,"^",2)
- SET APCDERR="DFN in HL7 doesn't match V POV patient."
- QUIT
- +4 IF VISIT'=$PIECE(Z,"^",3)
- SET APCDERR="VISIT in HL7 doesn't match V POV visit."
- QUIT
- +5 SET N=$PIECE(VPOV(APCDX),"^",2)
- SET %=$PIECE(Z,"^",4)
- SET %=$PIECE(^AUTNPOV(%,0),U)
- IF N'=%
- SET APCDERR="Provider Narratives mismatch"
- QUIT
- +6 ;file ICD code
- +7 SET ICD9=$PIECE(VPOV(APCDX),"^",3)
- SET ICD9=+$$CODEN^ICDEX(ICD9,80)
- IF +ICD9=-1
- SET ICD9=""
- IF ICD9=""
- SET APCDERR="Could not find ICD code in table."
- QUIT
- +8 NEW DD,DO,DA,DIC,DLAYGO,I,X,Y,%,%D,%E,%Y,D0,DI,DIE,DQ,DR,AUPNSEX
- +9 SET DA=$PIECE(VPOV(APCDX),"^")
- IF '$DATA(^AUPNVPOV(DA,0))
- SET APCDERR="VPOV no longer exists."
- QUIT
- +10 SET AUPNSEX=$PIECE(^DPT(DFN,0),"^",2)
- +11 SET DIE="^AUPNVPOV("
- SET DR=".01///"_ICD9
- DO ^DIE
- +12 IF $DATA(Y)
- SET APCDERR="Updating VPOV with code failed DIE."
- QUIT
- +13 QUIT
- End DoDot:1
- +14 QUIT
- MSGSET ;
- +1 SET APCDERR=""
- SET VPOVC=0
- +2 KILL VPOV
- +3 SET X=0
- FOR
- SET X=$ORDER(APCD3M(X))
- IF X'=+X!(APCDERR]"")
- QUIT
- SET Y=$PIECE(APCD3M(X),"|")
- IF $TEXT(@Y)]""
- DO @Y
- IF APCDERR]""
- DO LOGERR
- +4 QUIT
- MSH ;message segment check and set vars
- +1 SET Y=APCD3M(X)
- +2 SET SENDAPP=$PIECE(Y,"|",3)
- +3 SET SENDFAC=$PIECE(Y,"|",4)
- +4 SET RECAPP=$PIECE(Y,"|",5)
- +5 SET MSGDT=$PIECE(Y,"|",7)
- +6 SET MSGTYPE=$PIECE(Y,"|",9)
- +7 QUIT
- PID ;
- +1 SET Y=$PIECE(APCD3M(X),"|",2,999)
- +2 SET DFN=$PIECE(Y,"|",3)
- +3 IF DFN=""
- SET APCDERR="No DFN passed in HL7 message"
- QUIT
- +4 SET NAME=$PIECE(Y,"|",5)
- +5 SET DOB=$PIECE(Y,"|",3)
- +6 SET SEX=$PIECE(Y,"|",8)
- +7 QUIT
- PV1 ;
- +1 SET Y=$PIECE(APCD3M(X),"|",2,999)
- +2 SET VISIT=$PIECE(Y,"|",19)
- +3 IF VISIT=""
- SET APCDERR="No VISIT passed back in HL7 message."
- QUIT
- +4 IF '$DATA(^AUPNVSIT(VISIT,0))
- SET APCDERR="Visit has been deleted."
- QUIT
- +5 IF $PIECE(^AUPNVSIT(VISIT,0),"^",11)
- SET APCDERR="Visit has been deleted."
- QUIT
- +6 QUIT
- DG1 ;
- +1 SET Y=$PIECE(APCD3M(X),"|",2,999)
- SET Z=$ORDER(APCD3M(X))
- +2 IF 'Z
- SET APCDERR="No ZDX immediately following DG1"
- QUIT
- +3 IF $PIECE(APCD3M(Z),"|")'="ZDX"
- SET APCDERR="No ZDX immediately following DG1"
- QUIT
- +4 SET Z=$PIECE(APCD3M(Z),"|",2,999)
- +5 IF $PIECE(Y,"|",3)=""
- SET APCDERR="No diagnosis code passed back. "_$PIECE(Y,"|",1)
- QUIT
- +6 IF $PIECE(Z,"|",7)=""
- SET APCDERR="No VPOV ien passed back. "_$PIECE(Y,"|")
- QUIT
- +7 IF $PIECE(Z,"|")=""
- SET APCDERR="No provider narrative passed back. "_$PIECE(Y,"|")
- QUIT
- +8 SET VPOVC=VPOVC+1
- SET VPOV(VPOVC)=$PIECE(Z,"|",7)_"^"_$PIECE(Z,"|")_"^"_$PIECE(Y,"|",3)
- +9 QUIT
- +10 ;check for required items
- +11 ;patient dfn, visit ien, vpov ien and icd code and narrative
- LOGERR ; Log Application Error in IHS HL7 ERROR LOG FILE (#90074)
- +1 ;
- +2 NEW DD,DO,DA,DIC,DLAYGO,I,X,Y,%,%D,%E,%Y,D0,DI,DIE,DQ,DR
- +3 SET IEN772=$SELECT($GET(APCD3M(0)):"`"_APCD3M(0),1:"")
- +4 DO NOW^%DTC
- SET X=%
- +5 SET DIC="^BHL(90074,"
- SET DIC(0)="L"
- SET DLAYGO=90074
- +6 SET DIC("DR")=".02///^S X=RECAPP;.03///^S X=SENDAPP;.04///^S X=DUZ(2);.05///^S X=SENDFAC;.06///^S X=IEN772;.07///APCD3MF;.08///^S X=APCDERR"
- +7 KILL DD,DO
- DO FILE^DICN
- +8 QUIT
