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

PXKMAIN1.m

Go to the documentation of this file.
  1. PXKMAIN1 ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;Jul 26, 2021@09:35:17
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,124,178,210,216,211,217**;Aug 12, 1996;Build 134
  1. ;+This routine is responsible for:
  1. ;+ - creating new entries in PCE files,
  1. ;+ - processing modifications to existing entries,
  1. ;+ - deleting entries,
  1. ;+ - ensuring all required variables are present,
  1. ;+ - setting both Audit fields (EDITED FLAG and AUDIT TRAIL),
  1. ;+ - checking for duplicate entries,
  1. ;+ - some error reporting.
  1. ;+
  1. ;+LOCAL VARIABLE LIST
  1. ;+ MOST VARIABLES ARE DEFINED AT THE TOP OF PXKMAIN
  1. ;+ PXKSEQ = Sequence number in PXK TMP global
  1. ;+ PXKCAT = Category of entry (CPT,MSR,VST...)
  1. ;+ PXKREF = Root of temp global
  1. ;+ PXKPIEN = IEN of v file
  1. ;+ PXKAUDIT = data located in the audit field of the v file
  1. ;+ PXKER = field data use to build the DR string (e.g., .04///^S X=$G()
  1. ;+ PXKFLD = field number gleaned from the file routines
  1. ;+ PXKNOD = same as the subscript in a global node
  1. ;+ PXKPCE = the piece where the data is found on that node
  1. ;
  1. ;
  1. W !,"This is not an entry point" Q
  1. LOOP ;+Copy delimited strings into sub-arrays. PXKSUB is the node.
  1. F PXKI=1:1:$L(PXKAFT(PXKSUB),"^") I $P(PXKAFT(PXKSUB),"^",PXKI)'="" S PXKAV(PXKSUB,PXKI)=$P(PXKAFT(PXKSUB),"^",PXKI)
  1. F PXKI=1:1:$L(PXKBEF(PXKSUB),"^") I $P(PXKBEF(PXKSUB),"^",PXKI)'="" S PXKBV(PXKSUB,PXKI)=$P(PXKBEF(PXKSUB),"^",PXKI)
  1. K PXKI,PXKJ ; Not sure if NEW would be OK.
  1. I PXKCAT="CPT",PXKSUB=1 D LOOP^PXKMOD
  1. Q
  1. ;
  1. ERROR ;+Check for missing required fields
  1. Q:$G(PXKAV(0,1))["@"!('$D(PXKAV(0,1)))
  1. S PXKNOD=0,PXKPCE=0
  1. D EN1^@PXKRTN
  1. S PXKER=$P(PXKER," * ",1)
  1. I PXKER="" Q
  1. N PXJ,PXKFD,PXKFLD
  1. F PXJ=1:1:$L(PXKER,",") D
  1. . S PXJJ=$P(PXKER,",",PXJ)
  1. . I '$D(PXKAV(PXKNOD,PXJJ)) D
  1. .. S PXKPCE=PXJJ
  1. .. D EN2^@PXKRTN
  1. .. S PXKFLD=$P(PXKFD,"/",1)
  1. .. S:PXKFLD["*" PXKFLD=$P(PXKFLD," * ",2)
  1. .. S PXKERROR(PXKCAT,PXKSEQ,0,PXKFLD)="Missing Required Fields"
  1. Q
  1. ;
  1. CLEAN ;--Clean out the PXKAV array
  1. S PXKJ=""
  1. F S PXKJ=$O(PXKBV(PXKJ)) Q:PXKJ="" D
  1. . I PXKCAT="IMM",PXKJ?1(1"2",1"3",1"11") D CLEAN^PXKIMM(PXKJ) Q
  1. . S PXKI=""
  1. . F S PXKI=$O(PXKBV(PXKJ,PXKI)) Q:PXKI="" D
  1. . . I $G(PXKBV(PXKJ,PXKI))=$G(PXKAV(PXKJ,PXKI)) K PXKAV(PXKJ,PXKI)
  1. K PXKI,PXKJ ; Not sure about NEW here.
  1. Q
  1. ;
  1. FILE ;+Create a new entry in file and get IEN
  1. ;+This is the code that adds new entries to V-files
  1. ;+and to the Visit file.
  1. K DD,DO
  1. S DIC=$P($T(GLOBAL^@PXKRTN),";;",2)_"("
  1. S DIC(0)=""
  1. S X=$G(PXKAV(0,1))
  1. D FILE^DICN
  1. S (PXKPIEN,DA)=+Y
  1. S DR=""
  1. K DIC,Y,X
  1. I PXKCAT="IMM",PXKPIEN S PXVNEWIM=PXKPIEN S:$D(PXVNEWDA) PXVNEWDA=PXKPIEN ; PX*1*210
  1. Q
  1. ;
  1. AUD12 ;--Set both audit fields
  1. S DR=""
  1. S PXKAUDIT=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA,801)"
  1. S PXKAUDIT=$P($G(@PXKAUDIT),"^",2)_PXKSORR_";"
  1. I $L(PXKAUDIT,";")>5 S $P(PXKAUDIT,";",2,$L(PXKAUDIT,";"))="+;"_$P(PXKAUDIT,";",4,$L(PXKAUDIT,";")) ;PX*1*124 Change 8 to 5
  1. S PXKNOD=801
  1. S DR=""
  1. F PXKPCE=1,2 D EN1^@PXKRTN S DR=DR_PXKER
  1. I PXKCAT="IMM" D TMSTAMP
  1. S PXKFVDLM=""
  1. Q
  1. ;
  1. AUD2 ;--Set second audit fields
  1. S DR=""
  1. S PXKAUDIT=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA,801)"
  1. S PXKAUDIT=$P($G(@PXKAUDIT),"^",2)_PXKSORR_";"
  1. I $L(PXKAUDIT,";")>5 S $P(PXKAUDIT,";",2,$L(PXKAUDIT,";"))="+;"_$P(PXKAUDIT,";",4,$L(PXKAUDIT,";")) ;PX*1*124 Change 8 to 5
  1. S PXKNOD=801
  1. S DR=""
  1. S PXKPCE=2
  1. D EN1^@PXKRTN
  1. S DR=DR_PXKER
  1. I PXKCAT="IMM" D TMSTAMP
  1. S PXKFVDLM=""
  1. Q
  1. ;
  1. TMSTAMP ; set Timestamp
  1. S PXKNOW=$$NOW^XLFDT
  1. S PXKNOD=12
  1. S PXKPCE=21
  1. D EN1^@PXKRTN
  1. S DR=DR_PXKER
  1. Q
  1. ;
  1. DRDIE ;--Set the DR string and DO DIE
  1. I PXKCAT="VST" D UPD^PXKFVST Q
  1. ;
  1. S DIE=$P($T(GLOBAL^@PXKRTN),";;",2)_"(" K PXKPTR
  1. S PXKLR=$P($T(GLOBAL^@PXKRTN),";;",2)_"(DA)"
  1. ;
  1. S PXKNOD=""
  1. F S PXKNOD=$O(PXKAV(PXKNOD)) Q:PXKNOD="" D
  1. . I PXKFGAD=1,PXKNOD=0 S PXKPCE=1 D
  1. .. Q:PXKCAT'="CPT"
  1. .. I $G(^TMP("PXK",$J,PXKCAT,PXKSEQ,"IEN"))=PXKPIEN S PXKPCE=3
  1. . I PXKFGAD=1,PXKNOD'=0 S PXKPCE=0
  1. . I PXKFGED=1 S PXKPCE=0
  1. . I PXKCAT="CPT",PXKNOD=1 D Q
  1. .. D DIE
  1. .. ;I $G(^TMP("PXK",$J,PXKCAT,PXKSEQ,"IEN"))]"" Q
  1. .. D UPD^PXKMOD(PXKPIEN)
  1. . ;
  1. . I PXKCAT="IMM",PXKNOD?1(1"2",1"3",1"11") D DIE^PXKIMM Q
  1. . ;
  1. . F S PXKPCE=$O(PXKAV(PXKNOD,PXKPCE)) Q:PXKPCE="" D
  1. ..D EN1^@PXKRTN
  1. ..I $G(PXKER)'="" D
  1. ...I PXKER["~" D
  1. ....I $P(PXKER,"~",2)["A",PXKFGAD=1 S PXKER=$P(PXKER,"~") Q
  1. ....I $P(PXKER,"~",2)'["A",PXKFGAD=1 S PXKER="" Q
  1. ....I $P(PXKER,"~",2)["E",PXKFGED=1 S PXKER=$P(PXKER,"~") Q
  1. ....I $P(PXKER,"~",2)'["E",PXKFGED=1 S PXKER="" Q
  1. ...I +PXKER=0 D
  1. ....I PXKAV(PXKNOD,PXKPCE)=+PXKAV(PXKNOD,PXKPCE) S PXKER=$P(PXKER," * ",2)
  1. ....I PXKAV(PXKNOD,PXKPCE)'=+PXKAV(PXKNOD,PXKPCE) S PXKER=$P(PXKER," * ",3),PXKPTR(PXKPIEN,PXKNOD,PXKPCE)=""
  1. ..I $G(PXKER)'="" S DR=DR_PXKER_"PXKAV("_PXKNOD_","_PXKPCE_"));"
  1. ..I $L(DR)>200 D DIE
  1. D DIE
  1. K DIE,PXKLR,DIC(0)
  1. D ER
  1. Q
  1. ;
  1. DIE ;Invoke FM ^DIE call.
  1. D ^DIE
  1. K DR
  1. S DR=""
  1. Q
  1. ;
  1. DELETE ;+Use FM ^DIK call to delete entry identified by PXKPIEN.
  1. ;
  1. ; Make a copy of entry before deleting it
  1. I $T(DELGBL^@PXKRTN)'="" D COPYDEL
  1. ;
  1. S DA=PXKPIEN
  1. S DIK=$P($T(GLOBAL^@PXKRTN),";;",2)_"("
  1. D ^DIK
  1. K DIK
  1. Q
  1. ;
  1. COPYDEL ; Make a copy of entry
  1. ;
  1. N DA,DIC,DINUM,DIK,DO,PXDELGBL,PXGBL,PXKPDELIEN,PXTMP,X,Y
  1. ;
  1. S PXDELGBL=$P($T(DELGBL^@PXKRTN),";;",2)
  1. I $E(PXDELGBL,1)'="^" Q
  1. S PXGBL=$P($T(GLOBAL^@PXKRTN),";;",2)_"("
  1. ;
  1. ; add entry to deleted file
  1. S PXTMP=$G(@(PXGBL_PXKPIEN_",0)"))
  1. I $P(PXTMP,U,1)="" Q
  1. S X=$P(PXTMP,U,1)
  1. S DIC=PXDELGBL
  1. S DIC(0)=""
  1. L +@(PXDELGBL_PXKPIEN_")"):DILOCKTM
  1. ; if possible, try to assign same IEN in deleted file
  1. I '$D(@(PXDELGBL_PXKPIEN_")")) S DINUM=PXKPIEN
  1. D FILE^DICN
  1. L -@(PXDELGBL_PXKPIEN_")")
  1. ;
  1. ; Now copy the rest of the data.
  1. S PXKPDELIEN=$P(Y,U,1)
  1. I PXKPDELIEN'>0 Q
  1. L +@(PXDELGBL_PXKPDELIEN_")"):DILOCKTM
  1. M @(PXDELGBL_PXKPDELIEN_")")=@(PXGBL_PXKPIEN_")")
  1. S @(PXDELGBL_PXKPDELIEN_",880)")=DUZ_U_$$NOW^XLFDT
  1. S DIK=PXDELGBL
  1. S DA=PXKPDELIEN
  1. D IX1^DIK
  1. L -@(PXDELGBL_PXKPDELIEN_")")
  1. ;
  1. Q
  1. ;
  1. DUP ;+Code to check for duplicates
  1. I PXKCAT="VST" Q
  1. I PXKCAT="CPT" Q
  1. I PXKCAT="HF" Q
  1. N PXKRTN
  1. I '$D(PXKPIEN) N PXKPIEN S PXKPIEN=""
  1. S PXKNOD=0
  1. S PXKPCE=0
  1. S PXKRTN="PXKF"_PXKVCAT
  1. S PXKVRTN=$P($T(GLOBAL^@PXKRTN),";;",2)
  1. S PXJJJ=0
  1. D EN1^@PXKRTN
  1. I $P(PXKER," * ",3)'=0 D
  1. .S PXKER=$P(PXKER," * ",2)
  1. .I PXKER="" Q
  1. .S (PX,PXFG)=0
  1. .F S PX=$O(@PXKVRTN@("AD",PXKVST,PX)) Q:PX="" D Q:PXFG=1
  1. ..S PXJJJ=0
  1. ..F PXJ=1:1:$L(PXKER,",") S PXJJ=$P(PXKER,",",PXJ) D
  1. ...I $P($G(@PXKVRTN@(PX,$P(PXJJ,"+",1))),"^",$P(PXJJ,"+",2))=$G(PXKAV($P(PXJJ,"+",1),$P(PXJJ,"+",2))),PX'=PXKPIEN S PXJJJ=PXJJJ+1
  1. ..I $L(PXKER,",")=PXJJJ S PXFG=1
  1. ;PXKHLR Is not killed because it is a flag coming from another routine
  1. Q
  1. ;
  1. CPTMOD(VCPTIEN,MODIEN) ;
  1. N IND,VCPTE
  1. S IND=$O(^AUPNVCPT(VCPTIEN,1,"B",MODIEN,""))
  1. I IND="" S IND=1
  1. S VCPTE="^AUPNVCPT("_VCPTIEN_",1,"_IND_",0)"
  1. Q VCPTE
  1. ;
  1. ER ;--PXKERROR MAKING IF NOT POPULATED CORRECTLY
  1. N PXKRT,PXKMOD,PXKSTR
  1. S PXKMOD=PXKSEQ#1 I $G(PXKMOD) Q
  1. S PXKN=""
  1. F S PXKN=$O(PXKAV(PXKN)) Q:PXKN="" D
  1. . I PXKCAT="IMM",PXKN?1(1"2",1"3",1"11") D ER^PXKIMM Q
  1. . S PXKP=""
  1. . F S PXKP=$O(PXKAV(PXKN,PXKP)) Q:PXKP="" D
  1. .. S PXKRRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_DA_","
  1. .. I PXKN=1,PXKCAT="CPT" S PXKRRT=$$CPTMOD(PXKPIEN,PXKAV(PXKN,PXKP))
  1. .. E S PXKRRT=PXKRRT_PXKN_")"
  1. .. I PXKAV(PXKN,PXKP)'=$P($G(@PXKRRT),"^",$S(PXKN=1:1,1:PXKP)) D
  1. ... Q:PXKAV(PXKN,PXKP)["@"
  1. ... S PXKNOD=PXKN,PXKPCE=PXKP
  1. ... I PXKNOD=1,PXKCAT="CPT" S PXKPCE=1
  1. ... D EN2^@PXKRTN
  1. ... S PXKFLD=$P(PXKFD,"/",1)
  1. ... S:PXKFLD["*" PXKFLD=$P(PXKFLD," * ",2)
  1. ... Q:PXKFLD=1101
  1. ... S PXKSTR="Not Stored = "_PXKAV(PXKN,PXKP)
  1. ... I $G(PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD))]"" D
  1. .... S PXKSTR=PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD)_","_PXKAV(PXKN,PXKP)
  1. ... S PXKERROR(PXKCAT,PXKSEQ,DA,PXKFLD)=PXKSTR
  1. Q
  1. ;