- PXKMAIN ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;9/11/98
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117**;Aug 12, 1996
- ;+This routine is responsible for:
- ;+
- ;+LOCAL VARIABLE LIST:
- ;+ PXP59LOC = LOCK name (introduced in patch PX*1.0*59).
- ;+ PXFG = Stop flag with duplicate of delete
- ;+ PXKAFT = After node
- ;+ PXKBEF = Before node
- ;+ PXKAV = Pieces from the after node
- ;+ PXKBV = Pieces from the before node
- ;+ PXKERROR = Set when there is an error
- ;+ PXKFGAD = ADD flag
- ;+ PXKFGED = EDIT flag
- ;+ PXKFGDE = DELETE flag
- ;+ PXKSEQ = Sequence number in PXK tmp global
- ;+ PXKCAT = Category of entry (CPT,MSR,VST...)
- ;+ PXKREF = Root of temp global
- ;+ PXKPIEN = IEN of v file or the visit file
- ;+ PXKREF = The original reference we are ordering off of
- ;+ PXKRT = name of the node in the v file
- ;+ PXKRTN = routine name for the "f"ile routine
- ;+ PXKSOR = the data source for this entry
- ;+ PXKSUB = the subscript the data is located on the the v file
- ;+ PXKVST = the visit IEN
- ;+ PXKDUZ = the DUZ of the user
- ;+ *PXKHLR* = A variable set by calling routine so that duplicate
- ;+ PXKERROR messages aren't produced.
- ;
- W !,"This is not an entry point" Q
- EN1 ;+Main entry point to read ^TMP("PXK", Global
- ;+ Partial ^TMP Global Structure when called:
- ;+ ^TMP("PXK",$J,"SOR") = Source ien
- ;+
- ;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file
- ;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes.
- ;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = ""
- ;+
- ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = ""
- ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary
- ;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = ""
- ;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = ""
- ;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien
- ;+
- N PXP59LOC
- D LOCK
- K PXKERROR
- I '$G(PXKDUZ) D
- . I $G(DUZ) S PXKDUZ=DUZ
- . E S PXKDUZ=.5
- D VST
- I $D(PXP59LOC) D UNLOCK
- Q
- VST ;--Check for visit node and get one created or quit.
- I '$G(^TMP("PXK",$J,"VST",1,"IEN")) D
- .D VSIT^PXKVST
- I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-1 S PXKERROR("VISIT")="Visit Tracking could not get a visit." Q
- I +$G(^TMP("PXK",$J,"VST",1,"IEN"))=-2 S PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits." Q
- I +$G(^TMP("PXK",$J,"VST",1,"IEN"))<1 S PXKERROR("VISIT")="Did not get a visit^"_$G(^TMP("PXK",$J,"VST",1,"IEN")) Q
- ;
- NEW ;--New variables and set main variables
- N PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT
- N PXKCAT,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE
- N PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT
- N PXKPTR,PXDFG,PX,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKP
- N PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX
- PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2
- D PRVTYPE^PXKMAIN2
- ;
- SET ;--SET VARIABLES NECESSARY
- ;'DA' should not be defined at this point
- N DA ;PX*1.0*117
- ;
- S PXFG=0,TMPPX="^",PXKLAYGO="",PXDFG=0
- SOURCE S PXKSOR=$G(^TMP("PXK",$J,"SOR")) D Q:$D(PXKERROR("SOURCE"))
- .S PXKCO("SOR")=PXKSOR
- .I $D(PXKSOR)']"" S PXKERROR("SOURCE")="" Q
- VISIT S (PXKVST,VSIT("IEN"))=$G(^TMP("PXK",$J,"VST",1,"IEN"))
- ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables
- S PXKREF="^TMP(""PXK"",$J)"
- CATEG S PXKCAT="" F S (PXKCAT,PXKVCAT)=$O(@PXKREF@(PXKCAT)) Q:PXKCAT="" D
- .I PXKCAT="VST" S PXKVCAT="SIT"
- .S PXKRTN="PXKF"_PXKCAT
- .S X=PXKRTN X ^%ZOSF("TEST") Q:'$T
- SEQUE .S PXKSEQ=0 F S PXKSEQ=$O(@PXKREF@(PXKCAT,PXKSEQ)) K PXKAV,PXKBV S PXFG=0 Q:'PXKSEQ D
- ..S PXKPIEN=$G(@PXKREF@(PXKCAT,PXKSEQ,"IEN")),(PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0
- SUBSCR ..S PXKSUB="" F S PXKSUB=$O(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB)) Q:PXKSUB["IEN" Q:PXFG=1 Q:PXDFG=1 D
- AFTER ...S PXKAFT(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER"))
- BEFORE ...S PXKBEF(PXKSUB)=$G(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE"))
- ...I PXKCAT="CPT",PXKSUB=1 D SUBSCR^PXKMOD
- ...D LOOP^PXKMAIN1 D ERROR^PXKMAIN1 S PXDFG=0 I $G(PXKAV(0,1))["@"!('$D(PXKAV(0,1))) S PXKAFT(PXKSUB)="" K PXKAV(0) S PXDFG=1
- ..Q:PXFG=1
- ..I $D(PXKAV),'$D(PXKBV) S PXKSORR=PXKSOR_"-A "_PXKDUZ,PXKFGAD=1 I PXKCAT["VST" S PXKFGAD=0
- ..I '$D(PXKAV),$D(PXKBV) S PXKFGDE=1,PXKFVDLM="" D
- ...S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" I $D(@PXKRT) D DELETE^PXKMAIN1,EN1^PXKMASC S PXFG=1 K PXKRT Q
- ..I 'PXKFGAD,'PXKFGDE D CLEAN^PXKMAIN1 I $D(PXKAV) S PXKSORR=PXKSOR_"-E "_PXKDUZ,PXKFGED=1 I PXKCAT="VST",'$D(PXKBV),$D(PXKVST) S PXKFGED=0
- ..I 'PXKFGAD,'PXKFGDE,'PXKFGED,PXKCAT["VST" D EN1^PXKMASC
- ..I PXKFGAD=1 D Q:PXFG
- ...D ERROR^PXKMAIN1
- ...I $D(PXKERROR(PXKCAT,PXKSEQ)) S PXFG=1
- ...D:'PXFG DUP^PXKMAIN1
- ...I PXFG=1 D Q
- ....Q:PXKCAT'="CPT"
- ....I $G(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]"" D REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
- ...D:'PXKPIEN FILE^PXKMAIN1
- ...S:'$G(DA) DA=PXKPIEN
- ...D AUD2^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC
- ..I PXKFGED=1,PXKCAT'="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D AUD12^PXKMAIN1,DRDIE^PXKMAIN1,EN1^PXKMASC
- ..I PXKFGED=1,PXKCAT="VST" S PXKRT=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")" Q:'$D(@PXKRT) S DA=PXKPIEN D DUP^PXKMAIN1 Q:PXFG=1 D DRDIE^PXKMAIN1,EN1^PXKMASC
- ..D SPEC^PXKMAIN2
- ..K PXKAFT,PXKBEF
- I $D(^TMP("PXKSAVE",$J)) D RECALL^PXKMAIN2
- D EXIT
- Q
- EXIT ;--EXIT
- I $D(PXKFVDLM) D MODIFIED^VSIT(PXKVST)
- K PXKPXD,TMPPX
- K DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN") Q
- EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT
- ;Setting the variable PXKNOEVT=1 will stop the event from being
- ;fired off whenever any data is sent into PCE
- ;
- I $G(PXKNOEVT) K ^TMP("PXKCO",$J) Q
- N PXP59LOC
- D LOCK
- D EVENT^PXKMASC
- I $D(PXP59LOC) D UNLOCK
- Q
- LOCK ; Lock (results in PXP59LOC)--Patch PX*1.0*59.
- N PX0,PXWHO,PXWHERE,PXWHEN,PXEXIT,PXVISIT
- S PXEXIT=1,(PXWHO,PXWHERE,PXWHEN)=""
- ;First case: new visit data being saved.
- I 11[$D(^TMP("PXK",$J,"VST",1,0,"AFTER")) D
- . S PX0=^TMP("PXK",$J,"VST",1,0,"AFTER")
- . D L2
- ;Second case: use existing visit data.
- I 11[$D(^TMP("PXK",$J,"VST",1,"IEN")) D
- . S PXVISIT=+^TMP("PXK",$J,"VST",1,"IEN")
- . Q:'PXVISIT
- . Q:$D(^AUPNVSIT(PXVISIT,0))[0
- . S PX0=^AUPNVSIT(PXVISIT,0)
- . D L2
- ;Third case: Uses "PXKCO" instead of "PXK".
- I PXEXIT,$D(^TMP("PXKCO",$J)) D
- . S PXVISIT=$O(^TMP("PXKCO",$J,0))
- . Q:'PXVISIT
- . S PX0=$G(^TMP("PXKCO",$J,PXVISIT,"VST",PXVISIT,0,"AFTER"))
- . Q:PX0=""
- . D L2
- ;Fourth case: Uses "PXKENC" instead of "PXK".
- I PXEXIT,$D(^TMP("PXKENC",$J)) D
- . S PXVISIT=$O(^TMP("PXKENC",$J,0))
- . Q:'PXVISIT
- . S PX0=$G(^TMP("PXKENC",$J,PXVISIT,"VST",PXVISIT,0)) ; Look at ^TMP("PXKENC",$J
- . Q:PX0=""
- . D L2
- I PXEXIT Q ; Unable to obtain non-null subscripts.
- S PXP59LOC=$NA(^PXLOCK(PXWHO,PXWHERE,PXWHEN))
- L +@PXP59LOC:300
- E K PXP59LOC ; Lock was unsuccessful.
- Q
- L2 ; Get values from visit 0 node (PX0).
- I 'PXWHO S PXWHO=$P(PX0,U,5)
- I 'PXWHEN S PXWHEN=$P(PX0,U,1)
- I 'PXWHERE S PXWHERE=+$P(PX0,U,22)
- I PXWHO,PXWHEN S PXEXIT=0
- Q
- UNLOCK ; Unlock (use info in PXP59LOC)--Patch PX*1.0*59.
- L -@PXP59LOC
- Q
- PXKMAIN ;ISL/JVS,ISA/Zoltan - Main Routine for Data Capture ;9/11/98
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,59,73,88,69,117**;Aug 12, 1996
- +2 ;+This routine is responsible for:
- +3 ;+
- +4 ;+LOCAL VARIABLE LIST:
- +5 ;+ PXP59LOC = LOCK name (introduced in patch PX*1.0*59).
- +6 ;+ PXFG = Stop flag with duplicate of delete
- +7 ;+ PXKAFT = After node
- +8 ;+ PXKBEF = Before node
- +9 ;+ PXKAV = Pieces from the after node
- +10 ;+ PXKBV = Pieces from the before node
- +11 ;+ PXKERROR = Set when there is an error
- +12 ;+ PXKFGAD = ADD flag
- +13 ;+ PXKFGED = EDIT flag
- +14 ;+ PXKFGDE = DELETE flag
- +15 ;+ PXKSEQ = Sequence number in PXK tmp global
- +16 ;+ PXKCAT = Category of entry (CPT,MSR,VST...)
- +17 ;+ PXKREF = Root of temp global
- +18 ;+ PXKPIEN = IEN of v file or the visit file
- +19 ;+ PXKREF = The original reference we are ordering off of
- +20 ;+ PXKRT = name of the node in the v file
- +21 ;+ PXKRTN = routine name for the "f"ile routine
- +22 ;+ PXKSOR = the data source for this entry
- +23 ;+ PXKSUB = the subscript the data is located on the the v file
- +24 ;+ PXKVST = the visit IEN
- +25 ;+ PXKDUZ = the DUZ of the user
- +26 ;+ *PXKHLR* = A variable set by calling routine so that duplicate
- +27 ;+ PXKERROR messages aren't produced.
- +28 ;
- +29 WRITE !,"This is not an entry point"
- QUIT
- EN1 ;+Main entry point to read ^TMP("PXK", Global
- +1 ;+ Partial ^TMP Global Structure when called:
- +2 ;+ ^TMP("PXK",$J,"SOR") = Source ien
- +3 ;+
- +4 ;+ ^TMP("PXK",$J,"VST",1,0,"BEFORE") = the 0-node of the visit file
- +5 ;+ ^TMP("PXK",$J,"VST",1,0,"AFTER") = 0-node after changes.
- +6 ;+ ^TMP("PXK",$J,"VST",provider counter,"IEN") = ""
- +7 ;+
- +8 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"BEFORE") = ""
- +9 ;+ ^TMP("PXK",$J,"PRV",provider counter,0,"AFTER") = Provider id^DFN^Visitien^'P' or 'S' for primary/secondary
- +10 ;+ ^TMP("PXK",$J,"PRV",provider counter,"IEN") = ""
- +11 ;+ ^TMP("PXK",$J,"PRV",provider counter,"BEFORE") = ""
- +12 ;+ ^TMP("PXK",$J,"PRV",provider counter,"AFTER") = ^Package ien^Source ien
- +13 ;+
- +14 NEW PXP59LOC
- +15 DO LOCK
- +16 KILL PXKERROR
- +17 IF '$GET(PXKDUZ)
- Begin DoDot:1
- +18 IF $GET(DUZ)
- SET PXKDUZ=DUZ
- +19 IF '$TEST
- SET PXKDUZ=.5
- End DoDot:1
- +20 DO VST
- +21 IF $DATA(PXP59LOC)
- DO UNLOCK
- +22 QUIT
- VST ;--Check for visit node and get one created or quit.
- +1 IF '$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
- Begin DoDot:1
- +2 DO VSIT^PXKVST
- End DoDot:1
- +3 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))=-1
- SET PXKERROR("VISIT")="Visit Tracking could not get a visit."
- QUIT
- +4 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))=-2
- SET PXKERROR("VISIT")="PCE is not activated in Visit Tracking Parameters and thus cannot create visits."
- QUIT
- +5 IF +$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))<1
- SET PXKERROR("VISIT")="Did not get a visit^"_$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
- QUIT
- +6 ;
- NEW ;--New variables and set main variables
- +1 NEW PXKDFN,PXKSOR,PXKVST,PXKSEQ,PXFG,PXKAFT,PXKBEF,PXKAUDIT
- +2 NEW PXKCAT,PXKER,PXKFGAD,PXKFGED,PXKFGDE,PXKNOD,PXKPCE
- +3 NEW PXKPIEN,PXKREF,PXKRTN,PXKSORR,PXKSUB,PXKVCAT
- +4 NEW PXKPTR,PXDFG,PX,PXJJJ,PXKAFT8,PXKAFTR,PXKGN,PXKN,PXKP
- +5 NEW PXKRRT,PXKVRTN,PXKRT,PXKFVDLM,TMPPX
- PRVTYPE ;---DO PROVIDER TYPE--PXKMAIN2
- +1 DO PRVTYPE^PXKMAIN2
- +2 ;
- SET ;--SET VARIABLES NECESSARY
- +1 ;'DA' should not be defined at this point
- +2 ;PX*1.0*117
- NEW DA
- +3 ;
- +4 SET PXFG=0
- SET TMPPX="^"
- SET PXKLAYGO=""
- SET PXDFG=0
- SOURCE SET PXKSOR=$GET(^TMP("PXK",$JOB,"SOR"))
- Begin DoDot:1
- +1 SET PXKCO("SOR")=PXKSOR
- +2 IF $DATA(PXKSOR)']""
- SET PXKERROR("SOURCE")=""
- QUIT
- End DoDot:1
- IF $DATA(PXKERROR("SOURCE"))
- QUIT
- VISIT SET (PXKVST,VSIT("IEN"))=$GET(^TMP("PXK",$JOB,"VST",1,"IEN"))
- ORDER ;--$ORDER Through the ^TMP("PXK", global setting variables
- +1 SET PXKREF="^TMP(""PXK"",$J)"
- CATEG SET PXKCAT=""
- FOR
- SET (PXKCAT,PXKVCAT)=$ORDER(@PXKREF@(PXKCAT))
- IF PXKCAT=""
- QUIT
- Begin DoDot:1
- +1 IF PXKCAT="VST"
- SET PXKVCAT="SIT"
- +2 SET PXKRTN="PXKF"_PXKCAT
- +3 SET X=PXKRTN
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- QUIT
- SEQUE SET PXKSEQ=0
- FOR
- SET PXKSEQ=$ORDER(@PXKREF@(PXKCAT,PXKSEQ))
- KILL PXKAV,PXKBV
- SET PXFG=0
- IF 'PXKSEQ
- QUIT
- Begin DoDot:2
- +1 SET PXKPIEN=$GET(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
- SET (PXKFGAD,PXKFGDE,PXKFGED,PXDFG)=0
- SUBSCR SET PXKSUB=""
- FOR
- SET PXKSUB=$ORDER(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB))
- IF PXKSUB["IEN"
- QUIT
- IF PXFG=1
- QUIT
- IF PXDFG=1
- QUIT
- Begin DoDot:3
- AFTER SET PXKAFT(PXKSUB)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"AFTER"))
- BEFORE SET PXKBEF(PXKSUB)=$GET(@PXKREF@(PXKCAT,PXKSEQ,PXKSUB,"BEFORE"))
- +1 IF PXKCAT="CPT"
- IF PXKSUB=1
- DO SUBSCR^PXKMOD
- +2 DO LOOP^PXKMAIN1
- DO ERROR^PXKMAIN1
- SET PXDFG=0
- IF $GET(PXKAV(0,1))["@"!('$DATA(PXKAV(0,1)))
- SET PXKAFT(PXKSUB)=""
- KILL PXKAV(0)
- SET PXDFG=1
- End DoDot:3
- +3 IF PXFG=1
- QUIT
- +4 IF $DATA(PXKAV)
- IF '$DATA(PXKBV)
- SET PXKSORR=PXKSOR_"-A "_PXKDUZ
- SET PXKFGAD=1
- IF PXKCAT["VST"
- SET PXKFGAD=0
- +5 IF '$DATA(PXKAV)
- IF $DATA(PXKBV)
- SET PXKFGDE=1
- SET PXKFVDLM=""
- Begin DoDot:3
- +6 SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
- IF $DATA(@PXKRT)
- DO DELETE^PXKMAIN1
- DO EN1^PXKMASC
- SET PXFG=1
- KILL PXKRT
- QUIT
- End DoDot:3
- +7 IF 'PXKFGAD
- IF 'PXKFGDE
- DO CLEAN^PXKMAIN1
- IF $DATA(PXKAV)
- SET PXKSORR=PXKSOR_"-E "_PXKDUZ
- SET PXKFGED=1
- IF PXKCAT="VST"
- IF '$DATA(PXKBV)
- IF $DATA(PXKVST)
- SET PXKFGED=0
- +8 IF 'PXKFGAD
- IF 'PXKFGDE
- IF 'PXKFGED
- IF PXKCAT["VST"
- DO EN1^PXKMASC
- +9 IF PXKFGAD=1
- Begin DoDot:3
- +10 DO ERROR^PXKMAIN1
- +11 IF $DATA(PXKERROR(PXKCAT,PXKSEQ))
- SET PXFG=1
- +12 IF 'PXFG
- DO DUP^PXKMAIN1
- +13 IF PXFG=1
- Begin DoDot:4
- +14 IF PXKCAT'="CPT"
- QUIT
- +15 IF $GET(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))]""
- DO REMOVE^PXCEVFIL(@PXKREF@(PXKCAT,PXKSEQ,"IEN"))
- End DoDot:4
- QUIT
- +16 IF 'PXKPIEN
- DO FILE^PXKMAIN1
- +17 IF '$GET(DA)
- SET DA=PXKPIEN
- +18 DO AUD2^PXKMAIN1
- DO DRDIE^PXKMAIN1
- DO EN1^PXKMASC
- End DoDot:3
- IF PXFG
- QUIT
- +19 IF PXKFGED=1
- IF PXKCAT'="VST"
- SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
- IF '$DATA(@PXKRT)
- QUIT
- SET DA=PXKPIEN
- DO DUP^PXKMAIN1
- IF PXFG=1
- QUIT
- DO AUD12^PXKMAIN1
- DO DRDIE^PXKMAIN1
- DO EN1^PXKMASC
- +20 IF PXKFGED=1
- IF PXKCAT="VST"
- SET PXKRT=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_")"
- IF '$DATA(@PXKRT)
- QUIT
- SET DA=PXKPIEN
- DO DUP^PXKMAIN1
- IF PXFG=1
- QUIT
- DO DRDIE^PXKMAIN1
- DO EN1^PXKMASC
- +21 DO SPEC^PXKMAIN2
- +22 KILL PXKAFT,PXKBEF
- End DoDot:2
- End DoDot:1
- +23 IF $DATA(^TMP("PXKSAVE",$JOB))
- DO RECALL^PXKMAIN2
- +24 DO EXIT
- +25 QUIT
- EXIT ;--EXIT
- +1 IF $DATA(PXKFVDLM)
- DO MODIFIED^VSIT(PXKVST)
- +2 KILL PXKPXD,TMPPX
- +3 KILL DA,DR,PXKI,PXKJ,PXKLAYGO,PXKDUZ,PXKAFT8,PXKAFTR,VSIT("IEN")
- QUIT
- EVENT ;--ENTRY POINT TO POST EXECUTE PCE'S EVENT
- +1 ;Setting the variable PXKNOEVT=1 will stop the event from being
- +2 ;fired off whenever any data is sent into PCE
- +3 ;
- +4 IF $GET(PXKNOEVT)
- KILL ^TMP("PXKCO",$JOB)
- QUIT
- +5 NEW PXP59LOC
- +6 DO LOCK
- +7 DO EVENT^PXKMASC
- +8 IF $DATA(PXP59LOC)
- DO UNLOCK
- +9 QUIT
- LOCK ; Lock (results in PXP59LOC)--Patch PX*1.0*59.
- +1 NEW PX0,PXWHO,PXWHERE,PXWHEN,PXEXIT,PXVISIT
- +2 SET PXEXIT=1
- SET (PXWHO,PXWHERE,PXWHEN)=""
- +3 ;First case: new visit data being saved.
- +4 IF 11[$DATA(^TMP("PXK",$JOB,"VST",1,0,"AFTER"))
- Begin DoDot:1
- +5 SET PX0=^TMP("PXK",$JOB,"VST",1,0,"AFTER")
- +6 DO L2
- End DoDot:1
- +7 ;Second case: use existing visit data.
- +8 IF 11[$DATA(^TMP("PXK",$JOB,"VST",1,"IEN"))
- Begin DoDot:1
- +9 SET PXVISIT=+^TMP("PXK",$JOB,"VST",1,"IEN")
- +10 IF 'PXVISIT
- QUIT
- +11 IF $DATA(^AUPNVSIT(PXVISIT,0))[0
- QUIT
- +12 SET PX0=^AUPNVSIT(PXVISIT,0)
- +13 DO L2
- End DoDot:1
- +14 ;Third case: Uses "PXKCO" instead of "PXK".
- +15 IF PXEXIT
- IF $DATA(^TMP("PXKCO",$JOB))
- Begin DoDot:1
- +16 SET PXVISIT=$ORDER(^TMP("PXKCO",$JOB,0))
- +17 IF 'PXVISIT
- QUIT
- +18 SET PX0=$GET(^TMP("PXKCO",$JOB,PXVISIT,"VST",PXVISIT,0,"AFTER"))
- +19 IF PX0=""
- QUIT
- +20 DO L2
- End DoDot:1
- +21 ;Fourth case: Uses "PXKENC" instead of "PXK".
- +22 IF PXEXIT
- IF $DATA(^TMP("PXKENC",$JOB))
- Begin DoDot:1
- +23 SET PXVISIT=$ORDER(^TMP("PXKENC",$JOB,0))
- +24 IF 'PXVISIT
- QUIT
- +25 ; Look at ^TMP("PXKENC",$J
- SET PX0=$GET(^TMP("PXKENC",$JOB,PXVISIT,"VST",PXVISIT,0))
- +26 IF PX0=""
- QUIT
- +27 DO L2
- End DoDot:1
- +28 ; Unable to obtain non-null subscripts.
- IF PXEXIT
- QUIT
- +29 SET PXP59LOC=$NAME(^PXLOCK(PXWHO,PXWHERE,PXWHEN))
- +30 LOCK +@PXP59LOC:300
- +31 ; Lock was unsuccessful.
- IF '$TEST
- KILL PXP59LOC
- +32 QUIT
- L2 ; Get values from visit 0 node (PX0).
- +1 IF 'PXWHO
- SET PXWHO=$PIECE(PX0,U,5)
- +2 IF 'PXWHEN
- SET PXWHEN=$PIECE(PX0,U,1)
- +3 IF 'PXWHERE
- SET PXWHERE=+$PIECE(PX0,U,22)
- +4 IF PXWHO
- IF PXWHEN
- SET PXEXIT=0
- +5 QUIT
- UNLOCK ; Unlock (use info in PXP59LOC)--Patch PX*1.0*59.
- +1 LOCK -@PXP59LOC
- +2 QUIT
