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