- DGPMVBUR ;ALB/MIR - UR ADMISSION BULLETIN FOR MCCR ; 9/16/03 2:24pm
- ;;5.3;Registration;**26,31,483,549,570,1015**;AUG 13, 1993;Build 21
- ;
- UR ;UR bulletin
- K DGPMUR
- D INS I '$D(DGPMUR(10)) D URQ Q
- S DGPMX=$O(^XMB(3.8,"B","DGPM UR ADMISSION",0)) I '$O(^XMB(3.8,+DGPMX,1,0)) K DGPMX D URQ Q ; if no mailgroup members, quit
- S XMSUB="UR ADMISSION BULLETIN",XMTEXT="DGPMUR(",DGPMBLN=0
- S XMY("G.DGPM UR ADMISSION")="" ; pass mailgroup
- D PID^VADPT6 S DGPMBL="Admission for : "_$P(^DPT(DFN,0),"^",1)_" "_VA("PID") D SETLN
- S Y=+DGPMA X ^DD("DD") S DGPMBL="Date/Time : "_Y D SETLN
- S DGPMBL="Type of Admit : "_$S($D(^DG(405.1,+$P(DGPMA,"^",4),0)):$P(^(0),"^",1),1:"") D SETLN
- S DGPMBL=" " D SETLN
- S DGPMBL="Ward Location : "_$S($D(^DIC(42,+$P(DGPMA,"^",6),0)):$P(^(0),"^",1),1:"UNKNOWN") D SETLN
- S DGPMBL="Room-Bed : "_$S($D(^DG(405.4,+$P(DGPMA,"^",7),0)):$P(^(0),"^",1),1:"UNKNOWN") D SETLN
- S DGPMBL="Admitting DX : "_$P(DGPMA,"^",10) D SETLN
- S DGPMBL=" " D SETLN
- S DGPMBLN=DGPMLAST D V72HR ; visits in last 72 hours
- D DIS ;SC disabilities
- D ^XMD
- URQ K DGPMBL,DGPMBLN,DGPMLAST,DGPMUR,DGTMP,XMY,XMSUB,XMTEXT
- K %,%Y,DGPMOB,DGPMOW,DGPMX,I,X,X1,X2,Y,DGIBINS
- Q
- ;
- INS ;get insurance effective at time of admission, start at DGPMBLN=10
- Q ;ihs/cmi/maw 02/08/2012 patch 1014 no IB
- S DGPMBLN=9
- K DGIBINS
- N DGX,DGDATA,DGIB
- ;
- S DGIB=$$INSUR^IBBAPI(DFN,"","",.DGDATA,"*") ; Returns Active, Reimbursable Ins. only
- S DGX="DGDATA(""IBBAPI"",""INSUR"")" M DGIBINS=@DGX
- F I=0:0 S I=$O(DGIBINS(I)) Q:'I D ACT
- ;
- I $D(DGPMUR(10)) S DGPMLAST=DGPMBLN
- Q
- ;
- ACT ;is insurance active? If so, set in DGPMBLN array
- I DGIBINS(I,11)<+DGPMA,DGIBINS(I,11)]"" Q ;insurance expired before admission
- I DGIBINS(I,10)>+DGPMA Q ;insurance effective after admission
- Q:'+DGIBINS(I,1)
- ; get insurance company information
- S DGPMBL="Insurance Co. : "_$P(DGIBINS(I,1),"^",2) D SETLN
- S DGTMP=$P(DGIBINS(I,8),U,2)
- I DGTMP']"" S DGTMP=$S($G(DGIBNS(I,18))]"":DGIBINS(I,18),1:"")
- I DGTMP']"" S DGTMP=""
- I DGTMP]"" S DGPMBL="Group : "_DGTMP D SETLN
- S DGPMBL="Policy Holder : "_DGIBINS(I,13) D SETLN
- S DGPMBL="Subscriber ID : "_DGIBINS(I,14) D SETLN
- S DGPMBL="Ins. Co Phone# : "_$S(DGIBINS(I,6)]"":DGIBINS(I,6),1:"UNKNOWN") D SETLN
- S DGPMBL=" " D SETLN
- Q
- DIS ;rated disabilities
- I $S('$D(^DPT(DFN,.3)):1,$P(^(.3),"^",1)'="Y":1,1:"") Q ;not service connected...
- I $S('$D(^DPT(DFN,"VET")):1,$P(^("VET"),"^",1)'="Y":1,1:0),$S('$D(^DG(391,+$S($D(^DPT(DFN,"TYPE")):^("TYPE"),1:""),0)):1,$P(^(0),"^",2):0,1:1) Q
- ;X=0 node, X1=already one SC disability?
- S X1=0 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I I $D(^(I,0)) S X=^(0) I $P(X,"^",3)&$D(^DIC(31,+X,0)) S DGPMBL=$S('X1:"SC Disabilities: ",1:" ")_$P(^(0),"^",1)_" ("_+$P(X,"^",2)_"%)" S X1=1 D SETLN
- Q
- V72HR ; GET INFORMATION FROM VISITS FOR THE LAST 72 HOURS
- NEW X,X1,X2,IDEN,ID,LOCN,HSPN
- S X1=+DGPMA,X2=-3
- D C^%DTC
- S X=X-.0001
- GVTIME ; LOOP THROUGH "B" INDEX OF ^AUPNVSIT FILE
- S X=$O(^AUPNVSIT("B",X))
- I X="" Q
- I X'<+DGPMA Q
- S IDEN=""
- GVID ; CHECK FOR CORRECT PATIENT
- S IDEN=$O(^AUPNVSIT("B",X,IDEN))
- I IDEN="" G GVTIME
- I +$P($G(^AUPNVSIT(IDEN,0)),"^",5)'=+DFN G GVID
- S LOCN=$P(^AUPNVSIT(IDEN,0),"^",22)
- ; DG/549
- I $G(LOCN)>0 S HSPN=$P($G(^SC(LOCN,0)),"^",1)
- E S HSPN="Unknown location" I $P($G(^AUPNVSIT(IDEN,0)),"^",7)="E" S HSPN=HSPN_"-Event(Historical)"
- ;
- S Y=+X X ^DD("DD")
- S DGPMBL="Previous Visit : "_HSPN_" "_Y
- D SETLN
- G GVID
- Q
- SETLN ;--set line in xmtext array
- S DGPMBLN=DGPMBLN+1
- S DGPMUR(DGPMBLN)=DGPMBL
- Q
- DGPMVBUR ;ALB/MIR - UR ADMISSION BULLETIN FOR MCCR ; 9/16/03 2:24pm
- +1 ;;5.3;Registration;**26,31,483,549,570,1015**;AUG 13, 1993;Build 21
- +2 ;
- UR ;UR bulletin
- +1 KILL DGPMUR
- +2 DO INS
- IF '$DATA(DGPMUR(10))
- DO URQ
- QUIT
- +3 ; if no mailgroup members, quit
- SET DGPMX=$ORDER(^XMB(3.8,"B","DGPM UR ADMISSION",0))
- IF '$ORDER(^XMB(3.8,+DGPMX,1,0))
- KILL DGPMX
- DO URQ
- QUIT
- +4 SET XMSUB="UR ADMISSION BULLETIN"
- SET XMTEXT="DGPMUR("
- SET DGPMBLN=0
- +5 ; pass mailgroup
- SET XMY("G.DGPM UR ADMISSION")=""
- +6 DO PID^VADPT6
- SET DGPMBL="Admission for : "_$PIECE(^DPT(DFN,0),"^",1)_" "_VA("PID")
- DO SETLN
- +7 SET Y=+DGPMA
- XECUTE ^DD("DD")
- SET DGPMBL="Date/Time : "_Y
- DO SETLN
- +8 SET DGPMBL="Type of Admit : "_$SELECT($DATA(^DG(405.1,+$PIECE(DGPMA,"^",4),0)):$PIECE(^(0),"^",1),1:"")
- DO SETLN
- +9 SET DGPMBL=" "
- DO SETLN
- +10 SET DGPMBL="Ward Location : "_$SELECT($DATA(^DIC(42,+$PIECE(DGPMA,"^",6),0)):$PIECE(^(0),"^",1),1:"UNKNOWN")
- DO SETLN
- +11 SET DGPMBL="Room-Bed : "_$SELECT($DATA(^DG(405.4,+$PIECE(DGPMA,"^",7),0)):$PIECE(^(0),"^",1),1:"UNKNOWN")
- DO SETLN
- +12 SET DGPMBL="Admitting DX : "_$PIECE(DGPMA,"^",10)
- DO SETLN
- +13 SET DGPMBL=" "
- DO SETLN
- +14 ; visits in last 72 hours
- SET DGPMBLN=DGPMLAST
- DO V72HR
- +15 ;SC disabilities
- DO DIS
- +16 DO ^XMD
- URQ KILL DGPMBL,DGPMBLN,DGPMLAST,DGPMUR,DGTMP,XMY,XMSUB,XMTEXT
- +1 KILL %,%Y,DGPMOB,DGPMOW,DGPMX,I,X,X1,X2,Y,DGIBINS
- +2 QUIT
- +3 ;
- INS ;get insurance effective at time of admission, start at DGPMBLN=10
- +1 ;ihs/cmi/maw 02/08/2012 patch 1014 no IB
- QUIT
- +2 SET DGPMBLN=9
- +3 KILL DGIBINS
- +4 NEW DGX,DGDATA,DGIB
- +5 ;
- +6 ; Returns Active, Reimbursable Ins. only
- SET DGIB=$$INSUR^IBBAPI(DFN,"","",.DGDATA,"*")
- +7 SET DGX="DGDATA(""IBBAPI"",""INSUR"")"
- MERGE DGIBINS=@DGX
- +8 FOR I=0:0
- SET I=$ORDER(DGIBINS(I))
- IF 'I
- QUIT
- DO ACT
- +9 ;
- +10 IF $DATA(DGPMUR(10))
- SET DGPMLAST=DGPMBLN
- +11 QUIT
- +12 ;
- ACT ;is insurance active? If so, set in DGPMBLN array
- +1 ;insurance expired before admission
- IF DGIBINS(I,11)<+DGPMA
- IF DGIBINS(I,11)]""
- QUIT
- +2 ;insurance effective after admission
- IF DGIBINS(I,10)>+DGPMA
- QUIT
- +3 IF '+DGIBINS(I,1)
- QUIT
- +4 ; get insurance company information
- +5 SET DGPMBL="Insurance Co. : "_$PIECE(DGIBINS(I,1),"^",2)
- DO SETLN
- +6 SET DGTMP=$PIECE(DGIBINS(I,8),U,2)
- +7 IF DGTMP']""
- SET DGTMP=$SELECT($GET(DGIBNS(I,18))]"":DGIBINS(I,18),1:"")
- +8 IF DGTMP']""
- SET DGTMP=""
- +9 IF DGTMP]""
- SET DGPMBL="Group : "_DGTMP
- DO SETLN
- +10 SET DGPMBL="Policy Holder : "_DGIBINS(I,13)
- DO SETLN
- +11 SET DGPMBL="Subscriber ID : "_DGIBINS(I,14)
- DO SETLN
- +12 SET DGPMBL="Ins. Co Phone# : "_$SELECT(DGIBINS(I,6)]"":DGIBINS(I,6),1:"UNKNOWN")
- DO SETLN
- +13 SET DGPMBL=" "
- DO SETLN
- +14 QUIT
- DIS ;rated disabilities
- +1 ;not service connected...
- IF $SELECT('$DATA(^DPT(DFN,.3)):1,$PIECE(^(.3),"^",1)'="Y":1,1:"")
- QUIT
- +2 IF $SELECT('$DATA(^DPT(DFN,"VET")):1,$PIECE(^("VET"),"^",1)'="Y":1,1:0)
- IF $SELECT('$DATA(^DG(391,+$SELECT($DATA(^DPT(DFN,"TYPE")):^("TYPE"),1:""),0)):1,$PIECE(^(0),"^",2):0,1:1)
- QUIT
- +3 ;X=0 node, X1=already one SC disability?
- +4 SET X1=0
- FOR I=0:0
- SET I=$ORDER(^DPT(DFN,.372,I))
- IF 'I
- QUIT
- IF $DATA(^(I,0))
- SET X=^(0)
- IF $PIECE(X,"^",3)&$DATA(^DIC(31,+X,0))
- SET DGPMBL=$SELECT('X1:"SC Disabilities: ",1:" ")_$PIECE(^(0),"^",1)_" ("_+$PIECE(X,"^",2)_"%)"
- SET X1=1
- DO SETLN
- +5 QUIT
- V72HR ; GET INFORMATION FROM VISITS FOR THE LAST 72 HOURS
- +1 NEW X,X1,X2,IDEN,ID,LOCN,HSPN
- +2 SET X1=+DGPMA
- SET X2=-3
- +3 DO C^%DTC
- +4 SET X=X-.0001
- GVTIME ; LOOP THROUGH "B" INDEX OF ^AUPNVSIT FILE
- +1 SET X=$ORDER(^AUPNVSIT("B",X))
- +2 IF X=""
- QUIT
- +3 IF X'<+DGPMA
- QUIT
- +4 SET IDEN=""
- GVID ; CHECK FOR CORRECT PATIENT
- +1 SET IDEN=$ORDER(^AUPNVSIT("B",X,IDEN))
- +2 IF IDEN=""
- GOTO GVTIME
- +3 IF +$PIECE($GET(^AUPNVSIT(IDEN,0)),"^",5)'=+DFN
- GOTO GVID
- +4 SET LOCN=$PIECE(^AUPNVSIT(IDEN,0),"^",22)
- +5 ; DG/549
- +6 IF $GET(LOCN)>0
- SET HSPN=$PIECE($GET(^SC(LOCN,0)),"^",1)
- +7 IF '$TEST
- SET HSPN="Unknown location"
- IF $PIECE($GET(^AUPNVSIT(IDEN,0)),"^",7)="E"
- SET HSPN=HSPN_"-Event(Historical)"
- +8 ;
- +9 SET Y=+X
- XECUTE ^DD("DD")
- +10 SET DGPMBL="Previous Visit : "_HSPN_" "_Y
- +11 DO SETLN
- +12 GOTO GVID
- +13 QUIT
- SETLN ;--set line in xmtext array
- +1 SET DGPMBLN=DGPMBLN+1
- +2 SET DGPMUR(DGPMBLN)=DGPMBL
- +3 QUIT
