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

PXVDIS.m

Go to the documentation of this file.
  1. PXVDIS ;BPFO/LMT - Imm Disclosure Report ;06/22/16 17:04
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**216**;Aug 12, 1996;Build 11
  1. ;
  1. ;
  1. MAIN ;
  1. N PXAG,PXEXIT,PXFROM,PXPROMPT,PXPT,PXTO
  1. ;
  1. S PXEXIT=$$PROMPTDT(.PXFROM,.PXTO)
  1. I PXEXIT Q
  1. ;
  1. ; - Selection of AGENCY to print on the Report
  1. S PXPROMPT(1)="AGENCIES"
  1. S PXPROMPT(2)="AGENCY"
  1. S PXEXIT=$$PROMPT(920.71,.PXPROMPT,.PXAG)
  1. I PXEXIT Q
  1. K PXPROMPT
  1. ;
  1. ; - Selection of PATIENTS to print on the Report
  1. S PXPROMPT(1)="PATIENTS"
  1. S PXPROMPT(2)="PATIENT"
  1. S PXEXIT=$$PROMPT(2,.PXPROMPT,.PXPT)
  1. I PXEXIT Q
  1. ;
  1. D ASKDVC
  1. ;
  1. Q
  1. ;
  1. PROMPTDT(PXFROM,PXTO) ;
  1. ;
  1. N %DT,DTOUT,X,Y
  1. ;
  1. ; - Ask for FROM DATE
  1. S %DT(0)=-DT
  1. S %DT="AEP"
  1. S %DT("A")=" BEGIN DATE: "
  1. W !
  1. D ^%DT
  1. I Y<0!($D(DTOUT)) Q 1
  1. S PXFROM=$P(Y,".",1)
  1. ;
  1. ; - Ask for TO DATE
  1. K %DT,X,Y
  1. S %DT(0)=PXFROM
  1. S %DT="AEP"
  1. S %DT("B")="TODAY"
  1. S %DT("A")=" END DATE: "
  1. W !
  1. D ^%DT
  1. I Y<0!($D(DTOUT)) Q 1
  1. S PXTO=$P(Y,".",1)+.24
  1. ;
  1. Q 0
  1. ;
  1. PROMPT(PXFILE,PXPROMPT,PXRESP) ;
  1. ;
  1. N DIC,DLAYGO,DTOUT,DUOUT,X,Y
  1. ;
  1. W !!,?5,"You may select a single or multiple "_PXPROMPT(1)_","
  1. W !,?5,"or enter ^ALL to select all "_PXPROMPT(1)_".",!
  1. ;
  1. S DIC=PXFILE
  1. S DIC(0)="QEAM"
  1. S DIC("A")=" Select "_PXPROMPT(2)_": "
  1. F D ^DIC Q:Y<0 S PXRESP(+Y)="" S DIC("A")=" Another "_PXPROMPT(2)_": "
  1. I X="^ALL" S PXRESP="ALL" Q 0
  1. I $D(DUOUT)!($D(DTOUT)) Q 1
  1. I '$O(PXRESP(0)) Q 1
  1. Q 0
  1. ;
  1. MAIN2 ;
  1. ;
  1. N PXI,PXINDEX
  1. ;
  1. D CLEAN
  1. ;
  1. S PXINDEX="ADA"
  1. I $G(PXPT)'="ALL" S PXINDEX="ADP"
  1. I PXINDEX="ADA" D
  1. . I $G(PXAG)="ALL" D FIND(PXINDEX,"",.PXFROM,.PXTO,.PXAG,.PXPT) Q
  1. . S PXI=0
  1. . F S PXI=$O(PXAG(PXI)) Q:'PXI D
  1. . . D FIND(PXINDEX,PXI,.PXFROM,.PXTO,.PXAG,.PXPT)
  1. I PXINDEX="ADP" D
  1. . I $G(PXPT)="ALL" D FIND(PXINDEX,"",.PXFROM,.PXTO,.PXAG,.PXPT) Q
  1. . S PXI=0
  1. . F S PXI=$O(PXPT(PXI)) Q:'PXI D
  1. . . D FIND(PXINDEX,PXI,.PXFROM,.PXTO,.PXAG,.PXPT)
  1. ;
  1. D PRINT
  1. D CLEAN
  1. Q
  1. ;
  1. FIND(PXINDEX,PXSUB,PXFROM,PXTO,PXAG,PXPT) ;
  1. N PXGBL
  1. I PXSUB="" S PXGBL=$NA(^AUPNVIMM(PXINDEX,(PXFROM-.00001)))
  1. I PXSUB'="" S PXGBL=$NA(^AUPNVIMM(PXINDEX,(PXFROM-.00001),PXSUB))
  1. D FIND2(PXGBL,PXINDEX,.PXSUB,.PXFROM,.PXTO,.PXAG,.PXPT)
  1. I PXSUB="" S PXGBL=$NA(^AUPDVIMM(PXINDEX,(PXFROM-.00001)))
  1. I PXSUB'="" S PXGBL=$NA(^AUPDVIMM(PXINDEX,(PXFROM-.00001),PXSUB))
  1. D FIND2(PXGBL,PXINDEX,.PXSUB,.PXFROM,.PXTO,.PXAG,.PXPT)
  1. Q
  1. ;
  1. FIND2(PXGBL,PXINDEX,PXSUB,PXFROM,PXTO,PXAG,PXPT) ;
  1. ;
  1. N DFN,PXADMINDT,PXAGENCY,PXDISCDT,PXDISIEN,PXGBLRT,PXIMMUN,PXNODE,PXPATNM,PXVIMMIEN,PXVISIT,VADM
  1. ;
  1. S PXGBLRT=$S(PXGBL["AUPNVIMM":"^AUPNVIMM",1:"^AUPDVIMM")
  1. F S PXGBL=$Q(@PXGBL) Q:PXGBL="" Q:($QS(PXGBL,1)'=PXINDEX)!($QS(PXGBL,2)>PXTO)!((PXSUB'="")&($QS(PXGBL,3)'=PXSUB)) D
  1. . S PXDISCDT=$QS(PXGBL,2)
  1. . S PXVIMMIEN=$QS(PXGBL,4)
  1. . S PXDISIEN=$QS(PXGBL,5)
  1. . S PXAGENCY=$P($G(@PXGBLRT@(PXVIMMIEN,820,PXDISIEN,0)),U,1)
  1. . I $G(PXAG)'="ALL",'$D(PXAG(PXAGENCY)) Q
  1. . S PXAGENCY=$E($P($G(^PXV(920.71,+PXAGENCY,0)),U,1),1,35)
  1. . ;
  1. . S PXNODE=$G(@PXGBLRT@(PXVIMMIEN,0))
  1. . S DFN=$P(PXNODE,U,2)
  1. . I $G(PXPT)'="ALL",'$D(PXPT(DFN)) Q
  1. . D KVA^VADPT
  1. . D DEM^VADPT
  1. . S PXPATNM=$E(VADM(1),1,24)
  1. . S PXPATNM=PXPATNM_"("_$E($P(VADM(2),U),6,9)_")"
  1. . D KVA^VADPT
  1. . S PXIMMUN=$P(PXNODE,U,1)
  1. . S PXADMINDT=$P($G(@PXGBLRT@(PXVIMMIEN,12)),U,1)
  1. . I PXADMINDT="" D
  1. . . S PXVISIT=$P(PXNODE,U,3)
  1. . . S PXADMINDT=$P($G(^AUPNVSIT(PXVISIT,0)),U,1)
  1. . S ^TMP("PXVDIS",$J,PXDISCDT,PXAGENCY,PXPATNM,PXVIMMIEN)=PXIMMUN_U_PXADMINDT
  1. ;
  1. Q
  1. ;
  1. PRINT ;
  1. ;
  1. N PXAGENCY,PXDISCDT,PXEND,PXGBL,PXIMM,PXLINE,PXNODE,PXNOW,PXNUMLN,PXPAGE,PXPATNM,PXVIMM
  1. ;
  1. S PXEND=0
  1. S PXNOW=$$NOW^XLFDT
  1. S PXLINE=$$REPEAT^XLFSTR("-",131)
  1. S PXPAGE=0
  1. S PXNUMLN=$S($E(IOST,1,2)="C-":5,1:2)
  1. ;
  1. D PRINTHDR(PXNOW,.PXPAGE,PXLINE)
  1. ;
  1. S PXGBL=$NA(^TMP("PXVDIS",$J))
  1. F S PXGBL=$Q(@PXGBL) Q:PXGBL=""!($G(PXEND)) Q:($QS(PXGBL,1)'="PXVDIS")!($QS(PXGBL,2)'=$J) D
  1. . S PXDISCDT=$QS(PXGBL,3)
  1. . S PXAGENCY=$QS(PXGBL,4)
  1. . S PXPATNM=$QS(PXGBL,5)
  1. . S PXVIMM=$QS(PXGBL,6)
  1. . S PXNODE=$G(@PXGBL)
  1. . S PXIMM=$P(PXNODE,U,1)
  1. . W !,$$FMTE^XLFDT(PXDISCDT,"2M"),?16,PXAGENCY,?53,PXPATNM,?85,$E($P($G(^AUTTIMM(+PXIMM,0)),U,1),1,30)
  1. . W ?117,$$FMTE^XLFDT($P(PXNODE,U,2),"2M")
  1. . I $Y+PXNUMLN>IOSL D PRINTHDR(PXNOW,.PXPAGE,PXLINE)
  1. I '$G(PXEND) D PAUSE
  1. Q
  1. ;
  1. PRINTHDR(PXNOW,PXPAGE,PXLINE) ;
  1. ;
  1. I PXPAGE>0 D PAUSE
  1. I $G(PXEND) Q
  1. W @IOF
  1. S PXPAGE=PXPAGE+1
  1. W ?13,"ACCOUNTING OF DISCLOSURES REPORT"
  1. W !,?13,"Report printed on: ",$$FMTE^XLFDT(PXNOW),?88,"Page: ",PXPAGE
  1. W !,?13,"Date Range: "_$$FMTE^XLFDT(PXFROM,2)_" - "_$$FMTE^XLFDT($P(PXTO,".",1),2)
  1. W ?48,"Agency(ies): "_$S($G(PXAG)="ALL":"ALL",$O(PXAG($O(PXAG(0)))):"Multiple",1:$E($P($G(^PXV(920.71,+$O(PXAG(0)),0)),U,1),1,25))
  1. W ?88,"Patient(s): "_$S($G(PXPT)="ALL":"ALL",$O(PXPT($O(PXPT(0)))):"Multiple",1:$$GET1^DIQ(2,+$O(PXPT(0)),.01))
  1. W !!,"Info Disclosed: Name, DOB, Sex, Race, Ethnicity, Mother Maiden Name, Place of Birth, Address, Phone Number, NOK, Immunization Data"
  1. W !,"Purpose: Record and track a complete immunization history for the purpose of public health care coordination"
  1. W !!,"DT DISCLOSED",?16,"DISCLOSED TO",?53,"PATIENT",?85,"IMMUNIZATION",?117,"ADMIN DT"
  1. W !,PXLINE
  1. Q
  1. ;
  1. PAUSE ;
  1. N DIR,DIRUT,X,Y
  1. I $E(IOST,1,2)'="C-" Q
  1. W !
  1. S DIR(0)="E" D ^DIR
  1. I $D(DIRUT) S PXEND=1
  1. Q
  1. ;
  1. CLEAN ;
  1. K ^TMP("PXVDIS",$J)
  1. Q
  1. ;
  1. ASKDVC ;Prompts user for device of output (allows queuing)
  1. N PXVAR,ZTSK
  1. W !!!,"This report is designed for a 132 column format (compressed).",!
  1. S PXVAR("PXFROM")=""
  1. S PXVAR("PXTO")=""
  1. S PXVAR("PXAG(")=""
  1. S PXVAR("PXPT(")=""
  1. D EN^XUTMDEVQ("MAIN2^PXVDIS","Print Immunization Disclosure Report",.PXVAR,"QM",1)
  1. W:$D(ZTSK) !,"Report Queued to Print ("_ZTSK_").",!
  1. Q