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

SDTMPUT0.m

Go to the documentation of this file.
  1. SDTMPUT0 ;MS/SJA - TELEHEALTH SEARCH UTILITY ;Dec 17, 2020
  1. ;;5.3;Scheduling;**773,779,812,817,821,832,859,863**;Aug 13, 1993;Build 14
  1. ;Reference to ^DGCN(391.91 supported by IA #4943
  1. ;Reference to ^DIA(920.X,"C") supported by IA #2602
  1. ;
  1. N II,ARR,CNT,CODE,DEA,DFN,FAC,F407,S407,ICNHA,SIEN,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF
  1. N LTZ,SDASH,CTRY,TZEX,SDSL,SDRE,SDIN,SDNO,STP1,STP2,OPT,VADM,XX,ZD
  1. S $P(SDASH,"=",81)=""
  1. EN W @IOF W ?22,"Telehealth Inquiries",!!
  1. K DIRUT,DUOUT,DIR
  1. S DIR(0)="SA^C:Clinic;M:Medical Center Division;I:Institution;P:Patient Information;N:Patient ICN;L:List Stop Codes;S:Stop Code Lookup;SN:Station Number (Time Sensitive);R:Clinic Schedule Queuing Report;Q:QUIT"
  1. S DIR("A",1)=" Select one of the following:"
  1. S DIR("A",2)=""
  1. S DIR("A",3)=" C Clinic"
  1. S DIR("A",4)=" M Medical Center Division"
  1. S DIR("A",5)=" I Institution"
  1. S DIR("A",6)=" P Patient Information"
  1. S DIR("A",7)=" N Patient ICN"
  1. S DIR("A",8)=" L List Telehealth Stop Codes"
  1. S DIR("A",9)=" S Telehealth Stop Code Lookup"
  1. S DIR("A",10)=" SN Station Number (Time Sensitive)"
  1. S DIR("A",11)=" R Clinic Schedule Queuing Report"
  1. S DIR("A",12)=""
  1. S DIR("A")="Search Option or (Q)uit: "
  1. D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DIRUT) G END
  1. S OPT=Y W !
  1. D @OPT
  1. G EN
  1. ;
  1. C ; Search by clinic
  1. K DIC,SDCL,SDNO,NOD0,PNODE,DIV,SDSL,MCD,INST,INSTD,INSF,LTZ,CTRY,TZEX,CHAR4,CHAR4DSC
  1. S DIC="^SC(",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
  1. S DIC("A")="Select CLINIC: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X I +Y'>0 G:+Y<0 C
  1. S SDCL=Y,(DIV,MCD,INST,INSTD,INSF,LTZ,CTRY,TZEX)="" ;859
  1. S SDNO="",NODE0=$G(^SC(+SDCL,0)),DIV=$P(NODE0,U,15),SDSL=$G(^SC(+SDCL,"SL"))
  1. I DIV D ;859
  1. . S MCD=$G(^DG(40.8,DIV,0))
  1. . S INSTD=$P(MCD,U,7),INST=$P(NODE0,U,4)
  1. . S INSF=$G(^DIC(4,INSTD,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3)
  1. S CHAR4=$$CHAR4^SDESUTIL($P(SDCL,U,2)) S CHAR4DSC=$S(CHAR4="":"",1:CHAR4_"-"_$$CHAR4DSC^SDTMPUTL(CHAR4))
  1. W !!,SDASH
  1. W !,"Clinic",?18,": ",$TR(SDCL,"^","-")
  1. W !,"Default Provider",?18,": " I $P(NODE0,U,13) W $P(NODE0,U,13),"-",$P(^VA(200,$P(NODE0,U,13),0),U) W ?50,$$AUDIT(+SDCL)
  1. W !,"Provider",?18,": "
  1. S II=0 F S II=$O(^SC(+SDCL,"PR",II)) Q:'II D
  1. . I $D(^SC(+SDCL,"PR",II,0)) S PNODE=^SC(+SDCL,"PR",II,0) W ?20,+PNODE,"-",$P(^VA(200,+PNODE,0),U),?50,$S($P(PNODE,U,2):" << Default >>",1:""),!
  1. W:'$O(^SC(+SDCL,"PR",0)) ! W "Medical Division",?18,": " W:DIV DIV,"-",$$GET1^DIQ(40.8,DIV,.01)
  1. W !,"Institution",?18,": " W:INST INST,"-",$$GET1^DIQ(4,INST,.01)
  1. W !,"Station Number",?18,": ",$$GET1^DIQ(4,INST_",",99,"E")
  1. W !,"Instit.(derived)",?18,": " W:INSTD INSTD,"-",$$GET1^DIQ(4,INSTD,.01)
  1. W !,"Station (derived)",?18,": ",$$GET1^DIQ(4,INSTD_",",99,"E")
  1. W !,"Stop Code",?18,": " I $P(NODE0,U,7) W $P(NODE0,U,7),"-",$$GET1^DIQ(40.7,$P(NODE0,U,7),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,7),1),")"
  1. W !,"Credit Stop Code",?18,": " I $P(NODE0,U,18) W $P(NODE0,U,18),"-",$$GET1^DIQ(40.7,$P(NODE0,U,18),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,18),1),")"
  1. W !,"CHAR4",?18,": " W:$D(CHAR4DSC) CHAR4DSC ;821
  1. W !,"Country",?18,": " W:$D(CTRY) CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01)
  1. W !,"Location Timezone",?18,": " W:$D(LTZ) LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01)
  1. W !,"Timezone Exception",?18,": ",TZEX
  1. W !,"Overbooks per day",?18,": " W:$D(SDSL) $P(SDSL,U,7)
  1. W !,"Spec Instructions",?18,":"
  1. D SI
  1. D ACT
  1. W !,SDASH,! G C
  1. Q
  1. ;
  1. M ; Search by Medical Center Division
  1. K DEA,DIC,ZD,MCD,INST,INSF,LTZ,CTRY,TZEX
  1. S DIC="^DG(40.8,",DIC(0)="AEMQ" D ^DIC K DIC
  1. Q:"^"[X I +Y'>0 W !,$C(7),"Division not found. Please try again." G M
  1. S ZD=+Y
  1. S MCD=$G(^DG(40.8,ZD,0)),INST=$P(MCD,U,7)
  1. S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3)
  1. S DEA=$G(^DIC(4,INST,"DEA"))
  1. W !!,SDASH,!
  1. W !,"Medical Division",?18,": " W:ZD ZD,"-",$$GET1^DIQ(40.8,ZD,.01)
  1. W !,"Facility Number",?18,": ",$P(MCD,U,2)
  1. W !,"Institution",?18,": " W:INST INST,"-",$$GET1^DIQ(4,INST,.01)
  1. W !,"Facility DEA #",?18,": ",$P(DEA,U)
  1. W !,"Facility Exp. date",?18,": ",$$FMTE^XLFDT($P(DEA,U,2),2)
  1. W !,SDASH,!! G M
  1. Q
  1. ;
  1. I ; search by Institution
  1. K DEA,DIC,FAC,NOD0,NODE1,NODE8,II,ARR,LTZ,CTRY,TZEX,NODE99
  1. S DIC="^DIC(4,",DIC(0)="AEMNQ" D ^DIC K DIC Q:Y<1 0
  1. Q:"^"[X I +Y'>0 W !,$C(7),"Institution not found. Please try again." G I
  1. S FAC=Y
  1. S NODE0=$G(^DIC(4,+Y,0)),NODE1=$G(^DIC(4,+Y,1))
  1. S NODE8=$G(^DIC(4,+Y,8)),LTZ=$P(NODE8,U),CTRY=$P(NODE8,U,2),TZEX=$P(NODE8,U,3)
  1. S NODE99=$G(^DIC(4,+Y,99)),DEA=$G(^DIC(4,+FAC,"DEA"))
  1. W !!,SDASH,!
  1. W !,"Name",?18,": ",$TR(FAC,"^","-")
  1. W !,"City",?18,": ",$P(NODE1,U,3)
  1. W !,"State",?18,": " W:$P(NODE0,U,2) $P(NODE0,U,2),"-",$$GET1^DIQ(5,$P(NODE0,U,2),.01)
  1. W !,"District",?18,": ",$P(NODE0,U,3)
  1. W !,"VA region IEN",?18,": ",$P(NODE0,U,7)
  1. W !,"Location Timezone",?18,": " W:LTZ LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01)
  1. W !,"Timezone Exception",?18,": ",TZEX
  1. W !,"Country",?18,": " W:CTRY CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01)
  1. W !,"Station #",?18,": ",$P(NODE99,U)
  1. W !,"Facility DEA #",?18,": ",$P(DEA,U)
  1. W !,"Facility Exp. date",?18,": ",$$FMTE^XLFDT($P(DEA,U,2),2)
  1. S II=0 F S II=$O(^DIC(4,+FAC,7,II)) Q:'II K ARR D GETS^DIQ(4.014,II_","_+FAC,".01;1","E","ARR") D
  1. . W !,"Association" W:II ?18,": ",II_"-"_ARR(4.014,II_","_+FAC_",",.01,"E")
  1. . W ?40," Parent",": " W:II II_"-"_ARR(4.014,II_","_+FAC_",",1,"E")
  1. W !,SDASH,!! G I
  1. Q
  1. ;
  1. P ; search by patient
  1. K DIC,DFN,MPI,XX,ICNHA,VADM,SDDOD,SDDODN
  1. S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: " D ^DIC K DIC
  1. Q:"^"[X I +Y'>0 W !,$C(7),"Patient not found. Please try again." G P
  1. S DFN=+Y D 2^VADPT S MPI=$G(^DPT(DFN,"MPI"))
  1. S SDDOD=0,SDDOD=$O(^DGCN(391.91,"AKEY2",DFN,"USDOD",SDDOD))
  1. I SDDOD S SDDODN=$P(^DGCN(391.91,SDDOD,2),U,2)
  1. W !,SDASH
  1. W !,"Number (IEN)",?18,": ",DFN
  1. W !,"Name",?18,": ",VADM(1)
  1. W !,"Sex",?18,": ",$P(VADM(5),U,2)
  1. W !,"Date of Birth",?18,": ",$P(VADM(3),U,2)
  1. W !,"SSN",?18,": ",$P(VADM(2),U,2)
  1. W !,"DOD Number",?18,": ",$G(SDDODN)
  1. W !,"Full ICN",?18,": ",$P(MPI,U,10)
  1. W !,"Integrated Control: ",$P(MPI,U)
  1. W !,"ICN Checksum",?18,": ",$P(MPI,U,2)
  1. D ICN W !,"Full ICN History :" S XX=0 F S XX=$O(ICNHA(XX)) Q:'XX W ?20,$G(ICNHA(XX)),!
  1. W "Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@"),!
  1. D SC
  1. W !,SDASH G P
  1. Q
  1. ;
  1. N ; search by ICN
  1. W !,"Select ICN: " R SDICN:DTIME
  1. I SDICN=""!(SDICN="^") D SDCLN Q
  1. I SDICN="?"!(SDICN="??") D SDHELP G N
  1. I '$D(^DPT("AFICN",SDICN)) W $C(7)," ??" G N
  1. S DFN="",SDCNT=0 F S DFN=$O(^DPT("AFICN",SDICN,DFN)) Q:DFN="" S SDCNT=SDCNT+1 D:SDCNT=1 SDINQ D:SDCNT>1 SDINQ,SDMSG
  1. W !,"Records Found: ",SDCNT,!
  1. G N
  1. Q
  1. ;
  1. S ; Telehealth stop code
  1. K DIC,CODE,STP1,STP2,F407,S407
  1. S DIC="^SD(40.6,",DIC(0)="AEMNQ" D ^DIC K DIC
  1. Q:"^"[X I +Y'>0 W !,$C(7),"Telehealth Stop Code not found. Please try again." G S
  1. S CODE=$P(Y,U,2),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6)
  1. S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0))
  1. W !!,SDASH,!
  1. W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U)
  1. I $G(STP2) W !,"Stop Code: ",STP2," > ",$P($G(^DIC(40.7,S407,0)),U)
  1. W !,SDASH,!! K X,Y G S
  1. Q
  1. ;
  1. L ; list Telehealth stop codes
  1. K DIC,CNT,II,STP1,STP2,F407,S407
  1. S CNT=0 W !!,SDASH,!
  1. S II=0 F S II=$O(^SD(40.6,"B",II)) Q:'II D
  1. . S CNT=CNT+1,STP1=$E(II,1,3),STP2=$E(II,4,6)
  1. . S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0))
  1. . I STP2 W !,"Stop Code: ",STP1_STP2 D Q
  1. . . W !,?11,STP1," > ",$P($G(^DIC(40.7,F407,0)),U)
  1. . . W !,?11,STP2," > ",$P($G(^DIC(40.7,S407,0)),U)
  1. . W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U)
  1. W !,SDASH
  1. W !,"Total number of Telehealth Stop code: ",CNT,!!
  1. S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
  1. Q
  1. ;
  1. SN ; Search by Station Number
  1. K DIC,NODE0,II K ^TMP($J)
  1. N1 S DIC="^VA(389.9,",DIC(0)="AEMQ" D ^DIC K DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G N1
  1. I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q
  1. W !!,SDASH
  1. F II=0:0 S II=$O(^TMP($J,II)) Q:'II W ! D
  1. . S NODE0=$G(^VA(389.9,II,0))
  1. . W !,"Number: ",II,?35,"Reference Number: ",$P(NODE0,U)
  1. . W !,?2,"Effective Date: " I $P(NODE0,U,2) W $$FMTE^XLFDT($P(NODE0,U,2),1)
  1. . W ?35,"Medical Center Division: " W:$P(NODE0,U,3) $P(NODE0,U,3)_"-",$$GET1^DIQ(40.8,$P(NODE0,U,3),.01)
  1. . W !,?2,"Station Number: ",$P(NODE0,U,4),?35,"Inactive: ",$S($P(NODE0,U,6):"Yes",1:"No")
  1. . W !,?2,"Is Primary Division: ",$S($P(NODE0,U,5):"Yes",1:"No")
  1. . W !
  1. K ^TMP($J)
  1. W !!,SDASH,! G SN
  1. Q
  1. ;
  1. ICN ; full ICN history
  1. K ICNHA
  1. I '$D(^DPT(DFN,"MPIFICNHIS")) S ICNHA(1)="NO ICN HISTORY" Q
  1. S (SIEN,CNT)=0
  1. F S SIEN=$O(^DPT(DFN,"MPIFICNHIS",SIEN)) Q:'SIEN D
  1. . S FICN=$P($G(^DPT(DFN,"MPIFICNHIS",SIEN,0)),"^") I FICN'="" S CNT=CNT+1,ICNHA(CNT)=FICN
  1. I CNT=0 S ICNHA(1)="NO ICN HISTORY" Q
  1. S ICNHA=CNT
  1. Q
  1. ;
  1. ACT ; inactive clinic
  1. I $D(^SC(+SDCL,"I")) S SDRE=+$P(^("I"),U,2),SDIN=+^("I") I SDRE'=SDIN I SDIN'>DT&(SDRE=0!(SDRE>DT)) D
  1. . S Y=SDIN D DTS^SDUTL W !!,?4,"**** Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE S SDNO=1
  1. I '$G(SDNO),$D(SDIN),SDIN>DT,SDRE'=SDIN W !,?4,"**** Clinic will be inactive ",$S(SDRE:"from ",1:"as of ") S Y=SDIN D DTS^SDUTL W Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE
  1. Q
  1. ;
  1. END K ARR,CNT,CODE,CTRY,DFN,FAC,F407,S407,ICNHA,SIEN,II,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF
  1. K LTZ,SDASH,STP1,STP2,TZEX,SDSL,SDRE,SDIN,SDNO,OPT,VADM,XX,ZD
  1. Q
  1. ;
  1. SC ;SERVICE CONNECTED MESSAGE/IOFO - BAY PINES/TEH
  1. N VAEL
  1. I +$P($G(^DPT(DFN,.3)),U,2)>49 D
  1. . W !,?7,"********** THIS PATIENT IS 50% OR GREATER SERVICE-CONNECTED **********",!
  1. D 2^VADPT
  1. W !,"PATIENT'S SERVICE CONNECTION AND RATED DISABILITIES:"
  1. I $$GET1^DIQ(2,DFN_",",.301,"E")="YES"&($P(VAEL(3),"^",2)'="") D
  1. . W !,"SC Percent: "_$P(VAEL(3),"^",2)_"%"
  1. I $$GET1^DIQ(2,DFN_",",.301,"E")="NO"&($P(VAEL(3),"^",2)="") D
  1. . W !,"Service Connected: No"
  1. ;Rated Disabilities
  1. N SDSER,SDRAT,SDREC,NN,NUM
  1. S (NN,NUM)=0
  1. F S NN=$O(^DPT(DFN,.372,NN)) Q:'NN D
  1. . S SDREC=$G(^DPT(DFN,.372,NN,0)) I SDREC'="" D
  1. . . S SDRAT="" S NUM=$P($G(SDREC),"^",1) I NUM>0 S SDRAT=$$GET1^DIQ(31,NUM_",",.01)
  1. . . S SDSER="" S SDSER=$S($P(SDREC,"^",3)="1":"SC",1:"NSC")
  1. . . W !," "_SDRAT_" ("_SDSER_" - "_$P(SDREC,"^",2)_"%)"
  1. ;
  1. W !,"Primary Eligibility Code: "_$P(VAEL(1),"^",2)
  1. I $P($G(^DPT(DFN,.372,0)),"^",4)<1 W !,"No Service Connected Disabilities Listed"
  1. Q
  1. ;
  1. SDINQ ;Print inquiry
  1. D 2^VADPT S MPI=$G(^DPT(DFN,"MPI"))
  1. S SDDOD=0,SDDOD=$O(^DGCN(391.91,"AKEY2",DFN,"USDOD",SDDOD))
  1. I SDDOD S SDDODN=$P(^DGCN(391.91,SDDOD,2),U,2)
  1. W !,SDASH
  1. W !,"Full ICN",?18,": ",$P(MPI,U,10)
  1. W !,"Number (IEN)",?18,": ",DFN
  1. W !,"Name",?18,": ",VADM(1)
  1. W !,"Sex",?18,": ",$P(VADM(5),U,2)
  1. W !,"Date of Birth",?18,": ",$P(VADM(3),U,2)
  1. W !,"SSN",?18,": ",$P(VADM(2),U,2)
  1. W !,"DOD Number",?18,": ",$G(SDDODN)
  1. W !,"Integrated Control: ",$P(MPI,U)
  1. W !,"ICN Checksum",?18,": ",$P(MPI,U,2)
  1. D ICN W !,"Full ICN History :" S XX=0 F S XX=$O(ICNHA(XX)) Q:'XX W ?20,$G(ICNHA(XX)),!
  1. W "Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@"),!
  1. D SC
  1. W !,SDASH,!
  1. Q
  1. ;
  1. SDMSG ;Print warning for multiple ICN
  1. W !,$C(7)
  1. W "More than one Patient ICN exists in this VistA System, please contact your",!
  1. W "local Health Administration Services. If this is related to an INTRAfacility",!
  1. W "action, enter a Service Now ticket with your local HAS Office. If this is",!
  1. W "related to an INTERfacility action, enter an IAM Toolkit Request at",!
  1. W "http://vaww.vhadataportal.domain.ext/PolicyAdmin/HealthcareIdentityManagement.aspx",!
  1. Q
  1. ;
  1. SDCLN ;Clean up variables
  1. K SDCNT,DFN,ICNHA,FICN,MPI,SDICN,VA,VADM,XX,SDDOD,SDDODN
  1. Q
  1. ;
  1. SDHELP ;Help text
  1. W !," Enter the local or national Integration Control Number (ICN)",!
  1. W " assigned to the patient.",!
  1. Q
  1. ;
  1. SI ;Parse and display special instructions
  1. N N,I,E,S,SV
  1. S N=+$P($G(^SC(+SDCL,"SI",0)),U,3)
  1. I N=0 Q
  1. F I=1:1:N S X=$G(^SC(+SDCL,"SI",I,0)) D
  1. . I X="" Q
  1. . I $L(X)<61 W ?20,X W:I<N ! Q
  1. . S E=45 F S SV=E,E=$F(X," ",E) Q:E=0!(E=58)!(E>58) ;859 Parse comment on space
  1. . I E>58 S E=SV ;859 If line>58 go back to previous
  1. . S S=E ;859 S = divide between line 1 and 2
  1. . W ?20,$E(X,1,S-1),!,?22,$E(X,S,99)
  1. . I I<N W !
  1. Q
  1. ;
  1. R ;Clinic schedule queuing report
  1. D BEGIN^SDTMPPRC
  1. Q
  1. ;
  1. AUDIT(CLN) ; default provider audit
  1. N DATE,SDIEN,NODE,X
  1. K ^TMP($J,"AUDIT")
  1. S DATE="" F S DATE=$O(^DIA(44,"C",DATE)) Q:'DATE D
  1. . F SDIEN=0:0 S SDIEN=$O(^DIA(44,"C",DATE,SDIEN)) Q:'SDIEN S NODE=$G(^DIA(44,SDIEN,0)) D
  1. . . I $P(NODE,U,3)=16,($P(NODE,U)=CLN) S ^TMP($J,"AUDIT",DATE)=SDIEN_U_$$FMTE^XLFDT($P(NODE,U,2),"5MZ")
  1. Q:'$D(^TMP($J,"AUDIT")) ""
  1. S X=$O(^TMP($J,"AUDIT",""),-1)
  1. Q $P(^TMP($J,"AUDIT",X),U,2)