Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACDPCCL6

ACDPCCL6.m

Go to the documentation of this file. 
  1. ACDPCCL6 ;IHS/ADC/EDE/KML - PCC LINK;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1.  ; This routine adds v file entries to the visit just generated
  1.  ;
  1. VFILES ;EP Create v file entries
  1.  I ACDEV("TC")'="CS" D PRIPROV I 1
  1.  E  D CSPROVS,CSCPTS
  1.  D POV
  1.  D AT
  1.  D EOJ
  1.  Q 
  1.  ;
  1. PRIPROV ; v provider (primary provider)
  1.  S ACDPRVDR=ACDEV("PRI PROV")
  1.  S ACDPRVPS="P"
  1.  D PROV
  1.  I $G(ACDQUIT)'="" D VFERROR
  1.  Q
  1.  ;
  1. CSPROVS ; v providers (CS visits)
  1.  ; acdcsdte and acdloc are set prior to getting here
  1.  S ACDPRVPS="S"
  1.  S ACDPRVDR=0
  1.  F  S ACDPRVDR=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,"PROV",ACDPRVDR)) Q:'ACDPRVDR  D PROV I $G(ACDQUIT)'="" D VFERROR
  1.  Q
  1.  ;
  1. PROV ; v provider
  1.  S ACDFILE="V PROVIDER",ACDFILEN=9000010.06
  1.  D KILL
  1.  S APCDALVR("APCDVSIT")=APCDVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  S APCDALVR("APCDPAT")=ACDEV("PAT")
  1.  S APCDALVR("APCDTPS")="P"
  1.  S X=ACDPRVDR
  1.  I '$P($G(^AUTTSITE(1,0)),U,22) D
  1.  . NEW A,P
  1.  . S P=X,A=$P(^DIC(3,P,0),U,16)
  1.  . I A="" S ACDQUIT=42,X="" Q
  1.  . I $P(^VA(200,P,0),U)'=$P(^DIC(16,A,0),U) S ACDQUIT=42,X="" Q
  1.  . S X=A
  1.  . Q
  1.  I X="" S ACDQUIT=41 Q
  1.  S APCDALVR("APCDTPRO")="`"_X
  1.  D APCDALVR
  1.  Q
  1.  ;
  1. CSCPTS ; v cpt
  1.  S ACDFILE="V CPT",ACDFILEN=9000010.18
  1.  S ACDCSPRC=0
  1.  F  S ACDCSPRC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC)) Q:'ACDCSPRC  D
  1.  . D KILL
  1.  .;S APCDALVR("APCDTCPT")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTCPT")="`" S ACDQUIT=43 D VFERROR Q
  1.  . S APCDALVR("APCDTCPT")=+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTCPT")="" S ACDQUIT=43 D VFERROR Q
  1.  . S APCDALVR("APCDVSIT")=APCDVSIT
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.18 (ADD)]"
  1.  . S APCDALVR("APCDPAT")=ACDEV("PAT")
  1.  . S APCDALVR("APCDTPN")=$P(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
  1.  . S APCDALVR("APCDTPP")="Y"
  1.  . S APCDALVR("APCDOVRR")=""
  1.  . D APCDALVR
  1.  . Q
  1.  Q
  1.  ;
  1. CSPROCS ; v procedures ***** NO LONGER USED *****
  1.  S ACDFILE="V PROCEDURES",ACDFILEN=9000010.08
  1.  S ACDCSPRC=0
  1.  F  S ACDCSPRC=$O(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC)) Q:'ACDCSPRC  D
  1.  . D KILL
  1.  . S APCDALVR("APCDTPRC")="`"_+ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR") I APCDALVR("APCDTPRC")="`" S ACDQUIT=43 D VFERROR Q
  1.  . S APCDALVR("APCDVSIT")=APCDVSIT
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.08 (ADD)]"
  1.  . S APCDALVR("APCDPAT")=ACDEV("PAT")
  1.  . S APCDALVR("APCDTNQ")=$P(ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"NARR"),":",3)
  1.  . S APCDALVR("APCDOVRR")=""
  1.  . D APCDALVR
  1.  . Q
  1.  Q
  1.  ;
  1. POV ;create V POVS
  1.  S ACDFILE="V POV",ACDFILEN=9000010.07
  1.  S ACDY=0
  1.  F  S ACDY=$O(ACDEV("POV",ACDY)) Q:'ACDY  D
  1.  . D KILL
  1.  . S APCDALVR("APCDTPOV")="`"_+ACDEV("POV",ACDY) I APCDALVR("APCDTPOV")="`" S ACDQUIT=43 D VFERROR Q
  1.  . S APCDALVR("APCDTPS")=$S(ACDY=1:"P",1:"S")
  1.  . S APCDALVR("APCDVSIT")=APCDVSIT
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.07 (ADD)]"
  1.  . S APCDALVR("APCDPAT")=ACDEV("PAT")
  1.  . S APCDALVR("APCDTNQ")=$P(ACDEV("POV",ACDY),":",3)
  1.  . S APCDALVR("APCDOVRR")=""
  1.  . D APCDALVR
  1.  . Q
  1.  Q
  1.  ;
  1. AT ;create v activity time record
  1.  Q:'$G(ACDEV("TIME"))  ;          quit if no time
  1.  S ACDFILE="V ACTIVITY TIME",ACDFILEN=9000010.19
  1.  D KILL
  1.  S APCDALVR("APCDTACT")=ACDEV("TIME")
  1.  S APCDALVR("APCDVSIT")=APCDVSIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.19 (ADD)]"
  1.  S APCDALVR("APCDPAT")=ACDEV("PAT")
  1.  D APCDALVR
  1.  Q
  1.  ;
  1. APCDALVR ; GENERATE V FILE ENTRY
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S ACDQUIT=APCDALVR("APCDAFLG") D VFERROR Q
  1.  S ACDVFIEN=APCDALVR("APCDADFN")
  1.  S X=ACDFILEN,DA(2)=ACDEV("VISIT"),DA(1)=ACD21IEN,DIC="^ACDVIS("_DA(2)_",21,"_DA(1)_",11,",DIC(0)="L",DIC("DR")=".02////"_ACDVFIEN,DIC("P")=$P(^DD(9002172.121,1100,0),U,2)
  1.  I ACDEV("TC")="CS",ACDFILEN="9000010.18" S DIC("DR")=DIC("DR")_";.03////"_ACDEV("PROC",ACDCSDTE,ACDLOC,ACDCSPRC,"CS IEN")
  1.  D FILE^ACDFMC
  1.  Q
  1.  ;
  1. KILL ;
  1.  K APCDAFLG,APCDALVR,APCDANE,APCDAPPT,APCDATMP,APCDAUTO
  1.  K APCDCAT,APCDCLN
  1.  K APCDLOC
  1.  K APCDOLOC
  1.  K APCDPAT
  1.  K APCDTAT,APCDTLOU,APCDTNQ,APCDTPOV,APCDTPRO,APCDTPRV,APCDTPS,APCDTTOP,APCDTYPE
  1.  K AUPNTALK
  1.  Q
  1.  ;
  1. EOJ ;
  1.  D KILL
  1.  K ACD21IEN,ACDCSPRC,ACDERR,ACDFILE,ACDFILEN,ACDIEN,ACDPRVDR,ACDPRVPS,ACDQUIT,ACDVFIEN,ACDY
  1.  Q
  1.  ;
  1. VFERROR ; WRITE ERROR MESSAGE
  1.  S ACDIEN=$G(ACDEV("VISIT"))
  1.  S ACDERR="VE"_ACDQUIT,ACDERR=$P($T(@ACDERR),";;",2)_$G(APCDALVR("APCDADIE"))
  1.  W !!,$G(IORVON)_"Notify your supervisor that the PCC LINK failed with the following error:",!,ACDFILE,"-",ACDERR_$G(IORVOFF),!!
  1.  D PAUSE^ACDDEU
  1.  K ACDQUIT
  1.  Q
  1.  ;
  1. VE1 ;;incorrect template specification
  1. VE2 ;;invalid values being passed to V file.
  1. VE3 ;;invalid visit parameters (date, location etc.)
  1. VE41 ;;No PROVIDER ENTRY PASSED from CDMIS SYSTEM.
  1. VE42 ;;Could NOT convert 200 Pointer to 6 pointer.
  1. VE43 ;;Could not find ICD9 code in ICD Diagnosis file.