- PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;7/25/96 08:53
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73**;Aug 12, 1996
- ; Builds and passes data to MAS for Auto-checkout
- ;Variable List
- ;
- EN1 ;Build the Temp global for MAS AND THE WORLD.
- ;S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
- ;^TMP("PXKCO",$J,<VISIT IEN>,"PRV",<PROVIDER ien>,0,"AFTER")=DATA
- ; "" "" "" ,"BEFORE")=DATA
- N PXKGG,PXKSUB,PXKMOD,PXKSEQ
- Q:PXKSOR=$O(^PX(839.7,"B","PIMS CHECK-OUT",0))
- S PXKGG=0
- S PXKSUB=""
- F S PXKSUB=$O(PXKAFT(PXKSUB)) Q:PXKSUB="" D
- . I PXKSUB'=1 D PXGO Q
- . S PXKSEQ=""
- . F S PXKSEQ=$O(PXKAFT(PXKSUB,PXKSEQ)) Q:PXKSEQ="" D
- .. S PXKMOD=PXKAFT(PXKSUB,PXKSEQ)
- .. D PXGO
- Q
- PXGO ;
- S PXKGG=0
- S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
- I PXKSUB'=1 D
- . I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")) S PXKGG=1
- . S PXKGN=PXKGN_PXKSUB_")"
- I PXKSUB=1 D
- . I PXKMOD]"",$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMOD)) S PXKGG=1
- . S PXKGN=PXKGN_PXKSUB_","_PXKSEQ_","_0_")"
- D @$S(PXKGG=1:"DUP",1:"ORG")
- D DEL
- D PTR
- Q
- ;
- DUP ;Overwrite if a duplicate just the After Node
- I PXKSUB'=1 D Q
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
- I $G(@PXKGN)]"" D
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
- Q
- ;
- ORG ;If original copy both
- I PXKSUB'=1 D Q
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$G(PXKBEF(PXKSUB))
- I $G(@PXKGN)]"" D
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
- I $G(PXKBEF(PXKSUB,PXKSEQ))]"" D
- . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
- Q
- ;
- DEL ;DELETE IF BOTH ARE NULL
- I '$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0)) D
- .K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
- I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER"))']"" D
- .I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"BEFORE"))']"" D
- ..K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
- I $P($G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER")),"^",1)="@" D
- .K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
- Q
- ;
- PTR ; Set the Provider Narriative equal to the pointer in the files etc.
- N PXJ,PXJJ,PXJJJ,PXKR
- I $D(PXKPTR) S PXJ="" F S PXJ=$O(PXKPTR(PXJ)) Q:PXJ="" D
- .S PXJJ="" F S PXJJ=$O(PXKPTR(PXJ,PXJJ)) Q:PXJJ="" D
- ..S PXJJJ="" F S PXJJJ=$O(PXKPTR(PXJ,PXJJ,PXJJJ)) Q:PXJJJ="" D
- ...S PXKR=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXJ_","_PXJJ_")"
- ...I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER")) D
- ....S $P(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"),"^",PXJJJ)=$P($G(@PXKR),"^",PXJJJ)
- Q
- ;
- EVENT ; EVENT TO PRESENT THE DATA TO OTHER USERS
- Q:'$D(PXKCO("SOR"))
- I '$D(^TMP("PXKCO",$J)) Q
- S PXKVVST=+$O(^TMP("PXKCO",$J,0))
- S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER")=$G(^AUPNVSIT(PXKVVST,0))
- S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,21,"AFTER")=$G(^AUPNVSIT(PXKVVST,21))
- S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,800,"AFTER")=$G(^AUPNVSIT(PXKVVST,800))
- S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,811,"AFTER")=$G(^AUPNVSIT(PXKVVST,811))
- S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,150,"AFTER")=$G(^AUPNVSIT(PXKVVST,150))
- S ^TMP("PXKCO",$J,PXKVVST,"SOR",PXKCO("SOR"),0,"AFTER")=$G(^PX(839.7,PXKCO("SOR"),0))
- S ^TMP("PXKCO",$J,PXKVVST,"SOR",PXKCO("SOR"),0,"BEFORE")=$G(^PX(839.7,PXKCO("SOR"),0))
- S X=+$O(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
- ;D ENCEVENT^PXKENC(PXKVVST) ;makes the ^TMP("PXKENC",$J, array
- D COEVENT^PXKENC(PXKVVST) ;finishes the ^TMP("PXKCO",$J array
- D EN^XQOR
- D FINAL^SCDXHLDR(PXKVVST,$G(PXKVST))
- UPD ;UP DATE VISIT FILE
- ;--REMOVE CHECK OUT DATE TIME
- N VSIT
- I $D(PXKVVST),$D(^AUPNVSIT(PXKVVST)) S VSIT("IEN")=PXKVVST,VSIT("COD")="@" D UPD^VSIT
- K ^TMP("PXKCO",$J),PXKVVST,PXKCO,VSIT
- K ^TMP("PXKENC",$J)
- Q
- PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;7/25/96 08:53
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73**;Aug 12, 1996
- +2 ; Builds and passes data to MAS for Auto-checkout
- +3 ;Variable List
- +4 ;
- EN1 ;Build the Temp global for MAS AND THE WORLD.
- +1 ;S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
- +2 ;^TMP("PXKCO",$J,<VISIT IEN>,"PRV",<PROVIDER ien>,0,"AFTER")=DATA
- +3 ; "" "" "" ,"BEFORE")=DATA
- +4 NEW PXKGG,PXKSUB,PXKMOD,PXKSEQ
- +5 IF PXKSOR=$ORDER(^PX(839.7,"B","PIMS CHECK-OUT",0))
- QUIT
- +6 SET PXKGG=0
- +7 SET PXKSUB=""
- +8 FOR
- SET PXKSUB=$ORDER(PXKAFT(PXKSUB))
- IF PXKSUB=""
- QUIT
- Begin DoDot:1
- +9 IF PXKSUB'=1
- DO PXGO
- QUIT
- +10 SET PXKSEQ=""
- +11 FOR
- SET PXKSEQ=$ORDER(PXKAFT(PXKSUB,PXKSEQ))
- IF PXKSEQ=""
- QUIT
- Begin DoDot:2
- +12 SET PXKMOD=PXKAFT(PXKSUB,PXKSEQ)
- +13 DO PXGO
- End DoDot:2
- End DoDot:1
- +14 QUIT
- PXGO ;
- +1 SET PXKGG=0
- +2 SET PXKGN=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
- +3 IF PXKSUB'=1
- Begin DoDot:1
- +4 IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE"))
- SET PXKGG=1
- +5 SET PXKGN=PXKGN_PXKSUB_")"
- End DoDot:1
- +6 IF PXKSUB=1
- Begin DoDot:1
- +7 IF PXKMOD]""
- IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMOD))
- SET PXKGG=1
- +8 SET PXKGN=PXKGN_PXKSUB_","_PXKSEQ_","_0_")"
- End DoDot:1
- +9 DO @$SELECT(PXKGG=1:"DUP",1:"ORG")
- +10 DO DEL
- +11 DO PTR
- +12 QUIT
- +13 ;
- DUP ;Overwrite if a duplicate just the After Node
- +1 IF PXKSUB'=1
- Begin DoDot:1
- +2 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
- End DoDot:1
- QUIT
- +3 IF $GET(@PXKGN)]""
- Begin DoDot:1
- +4 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
- End DoDot:1
- +5 QUIT
- +6 ;
- ORG ;If original copy both
- +1 IF PXKSUB'=1
- Begin DoDot:1
- +2 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$GET(@PXKGN)
- +3 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$GET(PXKBEF(PXKSUB))
- End DoDot:1
- QUIT
- +4 IF $GET(@PXKGN)]""
- Begin DoDot:1
- +5 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$GET(@PXKGN))=""
- End DoDot:1
- +6 IF $GET(PXKBEF(PXKSUB,PXKSEQ))]""
- Begin DoDot:1
- +7 SET ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
- End DoDot:1
- +8 QUIT
- +9 ;
- DEL ;DELETE IF BOTH ARE NULL
- +1 IF '$DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0))
- Begin DoDot:1
- +2 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
- End DoDot:1
- +3 IF $GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"AFTER"))']""
- Begin DoDot:1
- +4 IF $GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"BEFORE"))']""
- Begin DoDot:2
- +5 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
- End DoDot:2
- End DoDot:1
- +6 IF $PIECE($GET(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN,0,"AFTER")),"^",1)="@"
- Begin DoDot:1
- +7 KILL ^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXKPIEN)
- End DoDot:1
- +8 QUIT
- +9 ;
- PTR ; Set the Provider Narriative equal to the pointer in the files etc.
- +1 NEW PXJ,PXJJ,PXJJJ,PXKR
- +2 IF $DATA(PXKPTR)
- SET PXJ=""
- FOR
- SET PXJ=$ORDER(PXKPTR(PXJ))
- IF PXJ=""
- QUIT
- Begin DoDot:1
- +3 SET PXJJ=""
- FOR
- SET PXJJ=$ORDER(PXKPTR(PXJ,PXJJ))
- IF PXJJ=""
- QUIT
- Begin DoDot:2
- +4 SET PXJJJ=""
- FOR
- SET PXJJJ=$ORDER(PXKPTR(PXJ,PXJJ,PXJJJ))
- IF PXJJJ=""
- QUIT
- Begin DoDot:3
- +5 SET PXKR=$PIECE($TEXT(GLOBAL^@PXKRTN),";;",2)_"("_PXJ_","_PXJJ_")"
- +6 IF $DATA(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"))
- Begin DoDot:4
- +7 SET $PIECE(^TMP("PXKCO",$JOB,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"),"^",PXJJJ)=$PIECE($GET(@PXKR),"^",PXJJJ)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 QUIT
- +9 ;
- EVENT ; EVENT TO PRESENT THE DATA TO OTHER USERS
- +1 IF '$DATA(PXKCO("SOR"))
- QUIT
- +2 IF '$DATA(^TMP("PXKCO",$JOB))
- QUIT
- +3 SET PXKVVST=+$ORDER(^TMP("PXKCO",$JOB,0))
- +4 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,0,"AFTER")=$GET(^AUPNVSIT(PXKVVST,0))
- +5 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,21,"AFTER")=$GET(^AUPNVSIT(PXKVVST,21))
- +6 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,800,"AFTER")=$GET(^AUPNVSIT(PXKVVST,800))
- +7 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,811,"AFTER")=$GET(^AUPNVSIT(PXKVVST,811))
- +8 SET ^TMP("PXKCO",$JOB,PXKVVST,"VST",PXKVVST,150,"AFTER")=$GET(^AUPNVSIT(PXKVVST,150))
- +9 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",PXKCO("SOR"),0,"AFTER")=$GET(^PX(839.7,PXKCO("SOR"),0))
- +10 SET ^TMP("PXKCO",$JOB,PXKVVST,"SOR",PXKCO("SOR"),0,"BEFORE")=$GET(^PX(839.7,PXKCO("SOR"),0))
- +11 SET X=+$ORDER(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
- +12 ;D ENCEVENT^PXKENC(PXKVVST) ;makes the ^TMP("PXKENC",$J, array
- +13 ;finishes the ^TMP("PXKCO",$J array
- DO COEVENT^PXKENC(PXKVVST)
- +14 DO EN^XQOR
- +15 DO FINAL^SCDXHLDR(PXKVVST,$GET(PXKVST))
- UPD ;UP DATE VISIT FILE
- +1 ;--REMOVE CHECK OUT DATE TIME
- +2 NEW VSIT
- +3 IF $DATA(PXKVVST)
- IF $DATA(^AUPNVSIT(PXKVVST))
- SET VSIT("IEN")=PXKVVST
- SET VSIT("COD")="@"
- DO UPD^VSIT
- +4 KILL ^TMP("PXKCO",$JOB),PXKVVST,PXKCO,VSIT
- +5 KILL ^TMP("PXKENC",$JOB)
- +6 QUIT
