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

BCHUTIL4.m

Go to the documentation of this file. 
  1. BCHUTIL4 ; IHS/CMI/LAB - UTILITIES ; 
  1.  ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1.  ;
  1. UNREQ ;EP - CALLED FROM SCREENMAN SCREEN
  1.  NEW BCHF
  1.  F BCHF=3,4,5 D REQ^DDSUTL(BCHF,2,"ENTER CHR DATA",0)
  1.  Q
  1. CANNEDNG() ;EP - return canned narrative
  1.  NEW BCHX
  1.  ;*****CALLED FROM SCREENMAN
  1.  S BCHX=$$GET^DDSVAL(90002.68,.DA,.04,"","I") I BCHX,$P($G(^BCHTSERV(BCHX,0)),U,4) D HLP^DDSUTL("You must type in a narrative for those services that pass to PCC") Q ""
  1.  I $$GET^DDSVAL(90002.68,.DA,.01,"","I")="" Q "<???>"
  1.  I $$GET^DDSVAL(90002.68,.DA,.04,"","I")="" Q $P(^BCHTPROB($$GET^DDSVAL(90002.01,.DA,.01,"","I"),0),U)
  1.  Q $E($P(^BCHTPROB($$GET^DDSVAL(90002.68,.DA,.01,"","I"),0),U)_":"_$P(^BCHTSERV($$GET^DDSVAL(90002.68,.DA,.04,"","I"),0),U),1,80)
  1.  ;
  1. NARRPOST ;EP
  1.  NEW BCHX
  1.  I BCHWTD="Y",X="" S BCHWTD="N"
  1.  I BCHWTD="Y",X]"" S DDSBR=5 Q
  1.  I X]"",BCHWTD="N" S DDACT="CL" Q
  1.  S BCHX=X
  1.  I BCHX="" S BCHX=$$CANNEDN^BCHUTIL() D:BCHX]"" PUT^DDSVAL(DIE,.DA,.06,BCHX,"","E")
  1.  I BCHX="" S DDSBR=2
  1.  ;S DDACT="CL"
  1.  Q
  1. SC(Y) ;EP - called from input transform
  1.  I $G(BCHPNP)=""!($G(BCHPNP)="N") Q 1
  1.  I BCHPNP="P",$P(^BCHTSERV(Y,0),U,6) Q 1
  1.  I BCHPNP="P",'$P(^BCHTSERV(Y,0),U,6) Q 0
  1.  Q 1
  1.  ;
  1. PR(Y) ;EP - called from input transform
  1.  ;I $G(BCHPNP)=""!($G(BCHPNP)="N") Q 1
  1.  I $G(BCHPNP)="P",$P(^BCHTPROB(Y,0),U,2)="AM" Q 0
  1.  I $G(BCHPNP)="P",$P(^BCHTPROB(Y,0),U,2)="LT" Q 0
  1.  Q 1
  1. SETNAR ;EP
  1.  Q:X=""
  1.  D PUT^DDSVAL(DIE,.DA,.06,$P(^BCHTCNAR(X,0),U,1),"","E")
  1.  Q
  1. SETDICS(PC,SC) ;EP
  1.  NEW PCSC,SCE
  1.  S SC=$G(SC)
  1.  I SC S SCE=$P(^BCHTSERV(SC,0),U,3)
  1.  S PC=$G(PC)
  1.  I PC S PC=$P(^BCHTPROB(PC,0),U,2)
  1.  S PCSC=PC_"-"_SCE
  1.  I $D(^BCHTCNAR(Y,11,"B",SC))!($D(^BCHTSERV(Y,12,"B",PCSC))) Q 1
  1.  Q 0
  1. GETNARRG(PC,SC) ;
  1.  K BCHCOUNT,BCHCANNN
  1.  K ^BCHGRPDA(DA,81)
  1.  NEW PCSC,SCE,C,X,PCN,V,N,Z
  1.  S C=0
  1.  S SC=$G(SC)
  1.  S SCE=""
  1.  I SC S SCE=$P(^BCHTSERV(SC,0),U,3)
  1.  S PC=$G(PC)
  1.  S PCN=""
  1.  I PC S PCN=$P(^BCHTPROB(PC,0),U,1),PC=$P(^BCHTPROB(PC,0),U,2)
  1.  S PCSC=PC_"-"_SCE
  1.  ;CHECK PCSC FIRST IN ACOMB
  1.  S O=0 F  S O=$O(^BCHTCNAR("ACOMB",PCSC,O)) Q:O'=+O  D
  1.  .S X=0 F  S X=$O(^BCHTCNAR("ACOMB",PCSC,O,X)) Q:X'=+X  D
  1.  ..Q:$P(^BCHTCNAR(X,0),U,2)'="G"
  1.  ..S Z=$$VAL^XBDIQ1(90002.59,X,.01)
  1.  ..I Z["DX-" S Z=Z_PC
  1.  ..S C=C+1,BCHCANNN(O)=O_U_Z_""_U_X
  1.  I $D(BCHCANNN) G SETG
  1.  ;NOW CHECK SC
  1.  S O=0 F  S O=$O(^BCHTCNAR("ASCO",SCE,O)) Q:O'=+O  D
  1.  .S X=0 F  S X=$O(^BCHTCNAR("ASCO",SCE,O,X)) Q:X'=+X  D
  1.  ..Q:$P(^BCHTCNAR(X,0),U,2)'="G"
  1.  ..S C=C+1,BCHCANNN(O)=O_U_$$VAL^XBDIQ1(90002.59,X,.01)_""_U_X
  1.  I $D(BCHCANNN) D SETG
  1.  Q
  1. SETG ;
  1.  NEW X,C,Y
  1.  S Y=0
  1.  S C=0 F  S C=$O(BCHCANNN(C)) Q:C'=+C  D
  1.  .S ^BCHGRPDA(DA,81,C,0)=C_U_$P(BCHCANNN(C),U,2)
  1.  .S ^BCHGRPDA(DA,81,"B",C,C)=""
  1.  .S ^BCHGRPDA(DA,81,0)="^90002.6881A^"_C_"^"_C
  1.  .S BCHCOUNT=Y
  1.  Q
  1.  ;
  1. NARRPREG ;EP
  1.  I BCHWTD="Y",$$GET^DDSVAL(DIE,DA,.06,,"I")]"" S DDSBR=5 Q
  1.  D HLP^DDSUTL("For services PC, HE, CF, CM, MP, EC and HS you must type a narrative.")
  1.  Q
  1.  ;
  1. NARRPOSG ;EP
  1.  NEW BCHX
  1.  I BCHWTD="Y",X="" S BCHWTD="N"
  1.  I BCHWTD="Y",X]"" S DDSBR=5 Q
  1.  I X]"",BCHWTD="N" S DDACT="CL" Q
  1.  S BCHX=X
  1.  I BCHX="" S BCHX=$$CANNEDNG() D:BCHX]"" PUT^DDSVAL(DIE,.DA,.06,BCHX,"","E")
  1.  I BCHX="" S DDSBR=2
  1.  ;S DDACT="CL"
  1.  Q
  1.  ;
  1. ADDNARRG ;EP
  1.  NEW BCHX,BCHY
  1.  I X="" Q
  1.  S BCHX=$$GET^DDSVAL(DIE,DA,.06,,"E")
  1.  S BCHY=$$GET^DDSVAL(DIE,DA,1101,,"E")
  1.  S BCHX=BCHX_" "_BCHY
  1.  D PUT^DDSVAL(DIE,DA,.06,BCHX,,"E")
  1.  D PUT^DDSVAL(DIE,DA,1101,"",,"I")
  1.  Q
  1. SETGNAR ;EP - called from canned narrative block
  1.  NEW BCHX,BCHY,BCHZ
  1.  S BCHY=""
  1.  S BCHX=0 F  S BCHX=$O(^BCHGRPDA(DA(1),92,BCHX)) Q:BCHX'=+BCHX  D
  1.  .I BCHY]"" S BCHY=BCHY_". "
  1.  .S BCHY=BCHY_$P($G(BCHCANNN($P(^BCHGRPDA(DA(1),92,BCHX,0),U,1))),U,2)
  1.  I BCHY]"" S BCHY=BCHY_"" D PUT^DDSVAL(90002.68,DA(1),.06,$E(BCHY,1,158),,"E")
  1.  Q